Copia / Incolla di più campi con ricerca su un campo specifico.   (04/08/03) modificato il 31/03/2017

Ancora un esercizio per copiare/incollare. In questo caso, simuliamo un elenco dati formato da più campi (colonne), e vorremo copiare tutti i dati di una stessa riga, dove uno dei campi corrisponda ad un certo criterio. Useremo un esempio classico: un indirizzario formato da 4 campi: Nominativo, indirizzo, città, telefono; l'esercizio : copiare tutti i dati dove esiste un numero di telefono. Questo esempio è adattabile ad ogni situazione, potrà essere applicato a tabelle dove un valore corrisponde ad un determinato numero, oppure ad una determinata parola, o ancora ad una determinata data, insomma, i casi si sprecano. Intanto vediamo la tabella scelta come esempio ( i dati sono di fantasia ):

  A B C D
1 Nominativo Indirizzo Città Telefono
2 Abbà Santino Via Crisi 13 Vengiù

0997-774411
3 Accatto Giuseppe Via Tappicchi 23 Citros  
4 Barabba Secondo Via Golgota 1 Maraneia 0985-667788
5 Bicchiere Limpido Via Tavole 5 Lavas 0966-996633
6 Catullo Rocco Via Roma 25 Calabellù  

Ed ora vediamo come operare. Due precisazioni: il formato celle del campo "Telefono" dovrà essere impostato a "Testo" per poter ospitare numeri con lo zero iniziale. In questo stesso campo, se non esiste il numero NON dovrà esserci comunque nessun valore (come zero, un trattino, ecc.) visto che useremo come chiave di selezione tutte le celle nel campo Telefono che saranno vuote ( "" ).

Useremo un ciclo For Each...Next che controlli tutte le celle, nel campo "Telefono", e per fornire i riferimenti del Range su cui operare (cioè da quante righe è composto l'elenco), useremo prendere gli estremi nella colonna A (Nominativo) con End, visto che questo campo sicuramente contiene dati, a differenza del campo telefono che può avere celle vuote. Poi con Offset controlliamo se esiste un numero di telefono, in caso positivo, selezioneremo l'intera riga copiandola, ed incollandola in un altro foglio, su cui useremo un ciclo Wend..While per trovare la prima cella libera dove incollare. Vediamo le istruzioni e le spiegazioni (in verde)

Sub Aricopia()
Application.ScreenUpdating = False 'serve per evitare i saltellamenti a schermo
Dim CEL As Object  'dichiariamo CEL come "Oggetto"
Set zona = Range(Range("A2"), Range("A2").End(xlDown)) 'con "zona" reperiamo tutto 'il range di celle dalla cella A2 (in A1 c'è "Nominativo") fino all'ultima cella occupata nella 'colonna A
For Each CEL In zona  'per ogni CEL( Oggetto cella) nel Range "zona"
If CEL.Offset(0, 3) <> "" Then   'se la cella 3 righe a desta (3) stessa riga (0) rispetto alla CEL in quel momento "spazzolata", è diversa da vuoto (quindi la cella che contiene il 'numero di telefono, lo contiene), allora

Range(CEL, CEL.Offset(0, 3)).Select 'si selezionano tutte le celle della stessa riga che 'vanno dalla CEL attiva fino alla cella Telefono
Selection.Copy  'si copia in memoria la selezione
Worksheets("Foglio2").Select 'quindi ci spostiamo sul foglio destinazione

Dim iRow As Integer 'iniziamo il ciclo per la ricerca della prima cella vuota, a partire dalla
iRow = 2  'riga due
While Cells(iRow, 1).Value <> ""  'fino a che la cella riga iRow, colonna 1 è occupata
iRow = iRow + 1  'si scala di riga incrementando di 1 il numero di riga
Wend   'quando si trova una cella libera
Cells(iRow, 1).Select  'la selezioniamo ed incolliamo ciò che è stato copiato
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
Worksheets("Foglio1").Select  'ritorniamo sul foglio di partenza

Next  'e si continua il ciclo sulla cella successiva fino alla fine di "zona"
Application.CutCopyMode = False  'elimina il tratteggio intorno alle celle copiate
End Sub

Modificato il 31/03/2017, dopo rilettura dei suggerimenti dati, con istruzioni più "moderne" che lavorano pore "a distanza" senza dover usare il Select:; uso lo stesso esempio della routine sopra Aricopia, così il lettore potrà confrontare la differenza tra le istruzioni che ho usato nel 2003 e quelle di oggi.

  • Non essendo più necessario, dato che si lavora "a distanza" e non avremo saltellamenti a video, usare lo ScreenUpdating

  • Per identificare la lunghezza (il numero di quante righe) di una serie di dati di una tabella, si usa la funzione End con la costante xlUp fornendo come inizio l'indirizzo (Address) dell'ultima cella di un foglio excel versione 2003 (quindi con solo 65536 righe), a salire, in una colonna che SICURAMENTE contenga il numero massimo di valori della tabella stessa, nell'esempio a inizio pagina, i nomi della colonna A; poichà la funzione End(xlUp) cerca la prima cella libera immediatamente sotto l'ultima occupata, della quale con la funzione Row rileviamo il numero di riga.

  • per cui avremo che la tabella occuperà dalla riga 1 alla riga 6 e useremo la differenza tra inizio e fine elenco utilizzando un ciclo For...Next , ciclo che scorra la collonna A per il numero di righe previsto dal contatore del ciclo M.

  • useremo per identificare le celle, non più i riferimenti in stile A1, ma la sintassi Cells(numero riga , numero colonna), questo ci permetterà non solo di scorrere le righe, ma di mirare alle celle che rispondano al criterio di ricerca o di selezione voluto, spostandoci, una volta intercettata una riga, di spostarci ed usare il contenuto della colonna che conterrà il valore da riportare. E così eliminiamo l'uso di Offset.

Sub Aricopia2()

UR = Range("A65536").End(xlDown).Row 'UR sarà quindi uguale a 7 nel nostro esempio di tabella

For M = 1 To UR
If  Cells(M, 4) <> "" Then   'se la cella colonna 4 della riga M in quel momento scorsa dal 'ciclo è diversa da vuoto (quindi la cella che contiene il 'numero di telefono, lo contiene), allora

Range(Cells(M, 1), Cells(M, 4)).Select 'si selezionano tutte le celle della stessa riga che 'vanno dalla CEL attiva fino alla cella Telefono
Selection.Copy  'si copia in memoria la selezione
'quindi si cerca su altro foglio (foglio2 ad esempio) SENZA selezionarlo la prima cella libera colonna A
Dim iRow As Integer 'iniziamo il ciclo per la ricerca della prima cella vuota, a partire dalla riga due
iRow = 2
While Worksheets("Foglio2").Cells(iRow, 1).Value <> ""  'fino a che la cella riga iRow, 'colonna 1 è 'occupata
iRow = iRow + 1  'si scala di riga incrementando di 1 il numero di riga
Wend   'quando si trova una cella libera si incolla tutto il copiato, sotto:

Worksheets("Foglio2").Cells(iRow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

Next  'e si continua il ciclo sulla cella successiva fino alla fine di UR
Application.CutCopyMode = False  'elimina il tratteggio intorno alle celle copiate
End Sub

 

Questo secondo esempio si presta ad una infinità di copia/incolla per diversi usi, come ad esempio cercare non chi ha il numero di telefono ma tutti i nomi di uno stesso cliente per riunirli in nuova tabella con tutti i loro dati correlati (sulla stessa riga) modificando opportunamente le istruzioni di ricerca.

 

Spero di essere stato chiaro.

 

Buon Lavoro.

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