Estrarre dati da un elenco e inviare il nuovo elenco in stampa.

A seguire dall'esempio della precedente pagina (Estrarre dati da elenco), propongo un esercizio un pò più articolato, e che spesso ci troviamo ad affrontare: disponendo di un database (elenco clienti, elenco fornitori, agenda indirizzi, elenco prodotti, ecc.ecc), vogliamo un riepilogo (o se preferite un "elenco filtrato") in modo da formare un nuovo elenco da mandare in stampa.

Premesso che ci sono diversi modi per ottenerlo, (compreso un ordinamento basato su chiave di ricerca che possiamo variare di volta in volta (agendo sulla chiave di ricerca), con selezione anche manuale dell'area che ci interessa e stampare poi questa selezione), questo esercizio è basato sulla ricerca di tutti i nomi che iniziano per una determinata lettera dell'alfabeto.

Una InputBox ci chiederà di quale lettera desideriamo eseguire il filtraggio ed estrazione dati , e le istruzioni provvederanno a comporre la nuova tabella con i nomi e i dati correlati che vorremo. Ho diviso le istruzioni in due macro: una per l'estrazione dati ed una per la stampa, ma è possibile unire le istruzioni in unica macro: estrarre i dati e mandarli in stampa in un colpo solo.

Attenzione!!: la ricerca è CaseSensitive, cioè è sensibile alle maiuscole/minuscole. Se formiamo il database con nomi di cui la prima lettera è scritta in maiuscolo (per esempio: Bellini) e nella inputbox, per la ricerca scriveremo b (minuscolo) saranno trovati solo i nomi con la b minuscola (e i Bellini no). Ricordatevi quindi di definire un sistema di ricerca che corrisponda al sistema usato per l'archiviazione dati, oppure nel modulo contenente la macro, nella sezione "Generale - Dichiarazioni", scrivere l'istruzione: Option Compare Text che serve a non rendere la ricerca CaseSensitive.

In questo esempio posizioniamo il database su un foglio (foglio2) mentre il riepilogo lo facciamo sul foglio 1 .Va bene qualunque altro foglio, è solo per lavorare con la ricerca dati da eseguire su un foglio "remoto" in modo da accontentare anche coloro che si chiedono come "pescare" i dati se si trovano non sullo stesso foglio del riepilogo. La foto sotto mostra un elenco a tre campi, (nominativo, indirizzo, città) sul foglio2:

Queste sotto invece mostrano la InputBox con la richiesta di quale lettera immettere (nell'esempio la "b"), e il foglio1 con l'elenco dei dati estratti relativi a tutti i nomi che nel database cominciano con la "b", ed i pulsanti associati alle due macro:

Sotto vediamo la zona che va in stampa. La macro interessata alla stampa, individua, a partire dalla riga 3, e per le tre colonne, l'ultima riga occupata, seleziona l'area così identificata, e la invia alla stampante. Soluzione necessaria visto che non è possibile stabilire a priori quanto sarà lungo l'elenco degli estratti.

Queste le due macro e relative spiegazioni:

Sub Riassumi()
Dim CL As Object
Dim x, messaggio, titolo
'questa sotto evita il saltellamento dei fogli a schermo
Application.ScreenUpdating = False

'siamo sul foglio1, si pulisce un'area da A3 a C200. Se gli elenchi estratti fossero più 'lunghi, basterà aumentare il range
Range("A3:C200").ClearContents

'si imposta il messaggio e il titolo della inputbox
messaggio = "Scrivi l'iniziale dei nomi da estrarre"
titolo = "Estrai dati"
'sotto: rendiamo x uguale a ciò che scriveremo nell'inputbox
x = InputBox(messaggio, titolo)
If x = "" Then Exit Sub  'se non scriviamo niente (x = vuoto) si esce dalla routine
'sotto: per ogni cella (CL) sul foglio2 nel range che va da A1 a A200
For Each CL In Sheets(2).Range("A1:A200")
Sheets(2).Select 'riseleziono il foglio2 al rientro del ciclo (Next)

'sotto: se la prima lettera a sinistra del valore che sarà nella cella è uguale alla prima lettera in x, (con 'Left(CL, 1) si confronta la prima lettera del nome che è nelle celle), allora
If Left(CL, 1) = Left(x, 1) Then
'sotto: si seleziona sul foglio2 dalla cella trovata alla 3^ cella, stessa riga
Sheets(2).Range(CL, CL.Offset(0, 2)).Select
Selection.Copy   'si copia la selezione

Sheets(1).Select  'ci si sposta sul foglio1
Range("A1").Select  'si seleziona la prima delle celle del nostro elenco di destinazione. (ricordo le prime due celle da far trovare occupare usando l'istruzione End)
Selection.End(xlDown).Select  'si cerca l'ultima cella occupata (la seconda)
ActiveCell.Offset(1, 0).Select  'si seleziona la cella sotto che è vuota

'incollo i dati (continuando a cercare (sopra) la prima cella libera.
With ActiveCell
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End With
End If
Next 'continuo il ciclo


Sheets(1).Select 'alla fine dell'estrazione ritorno sul foglio1
Range("C1").Select   'seleziono la cella C1
Application.CutCopyMode = False
End Sub

quella per la stampa:

Sub stampa()
Worksheets("Foglio1").Select
Dim x, y  'dichiarazione di variabili
y = Range("A3:C3").Address  'con y prendo i riferimenti dalla colonna A alla C riga 3
x = Range("A3").End(xlDown).Address  'con x prendo il riferimento alla ultima cella 'occupata nella colonna A partendo dalla cella A3
Range(y, x).Select   'seleziono tutta l'area identificata dai riferimenti y x
PrintArea = Selection   'dichiaro che l'area di stampa corrisponde alla selezione
Selection.PrintOut Copies:=1, Collate:=True   'invio la selezione alla stampante
Range("C1").Select
End Sub

20/02/03. L'amico Michele ( mic1947@libero.it ) mi suggerisce di fornire la soluzione alla limitazione maiuscole/minuscole che limita l'uso della routine di ricerca, con l'impiego delle funzioni LCase e UCase in modo che qualunque sia il formato della lettera scritta nell'inputbox, la ricerca venga comunque effettuata. Ritengo giusto il suggerimento e a questo punto aggiungo anche le istruzioni per l'ordinamento alfabetico con chiave di ordinamento basato sul nome, in modo che l'elenco degli estratti si presenti per ordine alfabetico. Questa la routine modificata, aggiungo le spiegazioni solo alle nuove istruzioni :

Sub riassumiordina()
Dim CL As Object
Dim x, messaggio, titolo

Application.ScreenUpdating = False
Range("A3:C200").ClearContents
messaggio = "Scrivi l'iniziale dei nomi da estrarre"
titolo = "Estrai dati"
x = InputBox(messaggio, titolo)
If x = "" Then Exit Sub


W = LCase(x) 'con LCase si assimila la variante x come lettera minuscola
Z = UCase(x)  'con UCase si assimila la variante x come lettera maiuscola

For Each CL In Sheets(2).Range("A1:A200")
Sheets(2).Select

'sotto: se la prima lettera del nome trovato è minuscola o maiuscola....
If Left(CL, 1) = Left(W, 1) Or Left(CL, 1) = Left(Z, 1) Then

Sheets(2).Range(CL, CL.Offset(0, 2)).Select
Selection.Copy

Sheets(1).Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

'incollo i dati.
With ActiveCell
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End With

End If
Next
Sheets(1).Select
'ritornati sul foglio1 si seleziona l'elenco estratti e si ordina alfabeticamente
y = Range("A3:C3").Address
x = Range("A3").End(xlDown).Address
Range(y, x).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'volendo mandare subito in stampa l'elenco, senza usare il secondo pulsante, e visto che 'l'elenco è già selezionato, possiamo aggiungere anche le istruzioni per la stampa:

PrintArea = Selection   'dichiaro che l'area di stampa corrisponde alla selezione
Selection.PrintOut Copies:=1, Collate:=True   'invio la selezione alla stampante

Range("C1").Select
Application.CutCopyMode = False
End Sub

File scaricabile e consultabile  (prima routine) :    Estraidati2000.zip     14 Kb

prelevato sul sito http://ennius.interfree.it