› Sviluppare funzionalita su Microsoft Office con VBA › MACRO CERCA VALORE IN UN FILE E COPIA 4 celle adiacenti
-
AutoreArticoli
-
salve, sono nuovo del forum, e nuovo di VBA.
Ho la necessità di cercare un valore della colonna B del FILEMASTER.xls all'interno di un secondo file (in questo caso fogliocassaxyz.xls che avrà nomi differenti giornalmente) e se presente il valore copiare le celle da B ad E adiacenti nel FILEMASTER
Vi allego i 2 file con i valori del file fogliocassaxyz.xls incollati manualmente nel filemaster.xls
Sarebbe ottimale per automatizzare il tutto inserire un pulsante nel foglio filemaster.xls e che vada a cercare i valori della colonna B in tutti i file (fogliocassa) con nomi differenti che magari carico dentro una cartella chiamata "controllo".
In allegato i due file
spero di essere stato chiaro, nel caso rispiego in fase di discussioneAllegati:
You must be logged in to view attached files.Scusa, ma la macro già presente RiportaDatiCliente che scopo avrebbe?
Ciao gibra, è una macro che non ha nessuno scopo, l'avevo creata per altre cose e dimenticata li. Mi è sfuggito cancellarla, scusami.
Però serviva allo stesso scopo. Io l'ho corretta ed ora funziona bene.
Ti ri-allego i file, esegui la macro e vedi...
N.B Per errore ho allegato due file uguali, ed il forum non mi consente di toglierli (e non capisco il perché) anzi me li ha numerati (Mah). Buttane uno e togli il numero finale (altrimenti la macro va in errore).
Allegati:
You must be logged in to view attached files.Però serviva allo stesso scopo. Io l'ho corretta ed ora funziona bene.
Grazie gibra. si così funziona, però non è quello che intendevo io.
Mi spiego meglio.
Giornalmente si ricevono 12 file di fogli cassa, ognuno con nomi differenti. Il mio obiettivo è quello magari di scaricare i 12 file dentro una cartella, magari chiamata "import", poi la macro va ad aprire tutti i file .xls (qualsiasi nome essi abbiano) che si trovano all'interno di "import" e deve fare un copia/incolla dei valori che fa nella ricerca, in quanto al termine i 12 file verranno eliminati e rimpiazzati il giorno successivo da altri 12 con altrettanti nomi differenti, quindi se possibile, fare in modo che vada ad analizzare tutti i file .xls che decideremo di mettere preventivamente dentro una cartella, come detto sopra "import".Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.
Scusami se non mi sono spiegato in anticipo prima, ma il copia/incolla in questo caso è essenziale compresa la ricerca sui file .xls qualsiasi nome essi ebbiano.
Grazie sempre in anticipo.
Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.
Scusa, ma adesso cosa c'entra il Copia&Incolla?
Spiegati meglio perché la macro:
1. non fa alcun CERCA.VERT
2. non fa il Copia&IncollaLa macro fa esattamente quello che hai chiesto all'inizio, vuol dire che non deve farlo?
Allora perché l'hai chiesto?
Non capisco...Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.
Si gibra, scusami... non sono ferrato su VBA, abbi pietà di me .. allora, la macro fa egregiamene il suo dovere... ma in questo caso solo sul file "fogliocassaxyz.xls"
è possibile modificarla, facendogli fare la ricerca non sul file specifico "fogliocassaxyz.xls" ma su tanti file "*.xls" che preventivamente vado a mettere dentro una cartella(directory) chiamata "import"?
esempio: io domani ricevo via mail 12 file
fogliocassaabcd.xsl
fogliocassa1234.xsl
fogliocassa8876.xsl
cassa1.xsl
cassa3.xls
etc... con nomi differenti
Vorrei che la macro andasse ad analizzare tutti questi file, che giornalmente avranno nomi differenti. Alla fine del lavoro, la cartella(directory) "import" verrà svuotata manualmente cancellando i file, così da riempirla l'indomani dagli altri file dei fogli cassa.Ti chiedo ancora scusa.. è possibile fare una cosa del genere?
Allora modifica la macro così:
Sub RiportaDatiCliente() Dim wbData As Workbook Dim wsData As Worksheet Dim rCel As Range Dim sFolderName As String, sBookName As String Dim lColonnaRicerca As Long, lLastRow As Long Dim bOpened As Boolean Dim vRow As Variant, vCode As Variant Dim i As Long '--- parametri ricerca da modifcare sFolderName = ThisWorkbook.Path & "\" '///sBookName = "fogliocassaXYZ.xls" '//"SUB 123_19.xls" lColonnaRicerca = 3 ' corretto (era 2) '---------------------------------------------- Application.ScreenUpdating = False '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE sBookName = Dir$(sFolderName & "fogliocassa*.xls") Do While sBookName <> "" bOpened = False ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo On Error Resume Next Set wbData = Workbooks(sBookName) If wbData Is Nothing Then Set wbData = Workbooks.Open(sFolderName & sBookName, , True) bOpened = True Err.Clear End If On Error GoTo 0 'On Error GoTo Uffa ' ora il file è aperto, procedo alla lettura dei dati '--- modifica il nome del foglio nel quale effettuare la ricerca Set wsData = wbData.Worksheets("Foglio1") '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '--- i codici si trovano in colonna B lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row For i = 1 To lLastRow vCode = .Cells(i, 2) 'If vCode = 23797 Then Stop If Len(vCode) Then vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0) If Not IsError(vRow) Then '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value Else '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found") End If End If Next i End With wbData.Close False ' chiudo il file Set wbData = Nothing sBookName = Dir$() ' leggo il prossimo Loop ExitHere: Application.ScreenUpdating = True On Error Resume Next If bOpened Then wbData.Close False Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing Exit Sub Uffa: Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _ CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _ "Codice in elaborazione: " & vCode, _ vbCritical + vbOKOnly, "Error message") Resume ExitHere End Sub
Allora modifica la macro così:
GRANDIOSO LAVORO!!!
ho fatto una correzzione impostando una cartella dove andrò a mettere i file, chiamata "\controllo\"'--- parametri ricerca da modifcare sFolderName = ThisWorkbook.Path & "\controllo\" '///sBookName = "fogliocassaXYZ.xls" '//"SUB 123_19.xls" lColonnaRicerca = 3 ' corretto (era 2) '----------------------------------------------
e poi ho impostato che deve aprire tutti i file xls
Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE sBookName = Dir$(sFolderName & "*.xls") Do While sBookName <> "" bOpened = False
e funziona alla grande!!!!
P.S.
domandona: nel caso volessi aggiungere al filemaster.xls altri fogli con altri codici da cercare...
quindi: foglio2 - foglio 3 - foglio 4 etc...
lascio tutto così ed eseguo la macro per ogni singolo foglio o devo specificare qualcosa nella macro?ho allegato il file con le mie modifiche, se devi fare delle prove, crea la directory "controllo" per i file da controllare
Allegati:
You must be logged in to view attached files.nel caso volessi aggiungere al filemaster.xls altri fogli con altri codici da cercare... quindi: foglio2 - foglio 3 - foglio 4 etc...
lascio tutto così ed eseguo la macro per ogni singolo foglio o devo specificare qualcosa nella macro?Dopo aver aperto il file la macro esegue
Set wsData = wbData.Worksheets("Foglio1")
devi sostituire questa istruzione inserendola dentro un ciclo che esamini ogni foglio di wbData:
Dim sh As Worksheet For Each sh in wbData.Sheets Set wsData = sh ' il resto del codice che hai già non cambia Next
Dopo aver aperto il file la macro esegue
Set wsData = wbData.Worksheets("Foglio1")
devi sostituire questa istruzione inserendola dentro un ciclo che esamini ogni foglio di wbData:
Dim sh As WorksheetFor Each sh in wbData.Sheets Set wsData = sh ' il resto del codice che hai già non cambiaNext
Ciao gibra, non capisco come fare, mi potresti postare l'intero codice fatto magari per 3 fogli inseriti su filemaster.xls? poi capendo come hai scritto il codice aggiungo gli altri fogli io personalizzandolo.
Ciao gibra, non capisco come fare
Te l'ho scritto, segui le mie istruzioni.
Dai, su, un po' di intraprendenza!!!
Una volta modificato, se hai problemi, ri-pubblica il file master con le tue modifiche e vediamo.
'--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '
--- i codici si trovano in colonna B
Gibra, dalla modifica che mi hai proposto, ho "intuito" che la ricerca la fa ciclica sui fogli1 etc dei file che ricevo via mail...
Quello che intendevo io invece riguarda i fogli che contengono i codici da ricercare ..
In allegato ti metto il file "filemaster.xls" con l'aggiunta di altri 2 fogli con codici da cercare.
In allegato ti metto pure i 2 file test da mettere dentro la directory "controllo" con l'aggiunta dei codici che si trovano nei 3 fogli del filemaster.
Infatti ho provato a cambiare il codice
ThisWorkbook.Worksheets("Foglio1") in ThisWorkbook.Worksheets("Foglio2") e mi trova i codici del foglio2 ...io volevo questo, cercare i codici non soltanto nel foglio1 del filemaster.xls ma anche nel foglio2, 3, etc... o meglio ancora in tutta la cartella del filemaster.xls
Allegati:
You must be logged in to view attached files.Mostra il codice modificato del file master, come ti ho spiegato di fare.
Mostra il codice modificato del file master, come ti ho spiegato di fare.
Sub RiportaDatiCliente() Dim wbData As Workbook Dim wsData As Worksheet Dim rCel As Range Dim sFolderName As String, sBookName As String Dim lColonnaRicerca As Long, lLastRow As Long Dim bOpened As Boolean Dim vRow As Variant, vCode As Variant Dim i As Long '--- parametri ricerca da modifcare sFolderName = ThisWorkbook.Path & "\controllo\" '///sBookName = "fogliocassaXYZ.xls" '//"SUB 123_19.xls" lColonnaRicerca = 3 ' corretto (era 2) '---------------------------------------------- Application.ScreenUpdating = False '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE sBookName = Dir$(sFolderName & "*.xls") Do While sBookName <> "" bOpened = False ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo On Error Resume Next Set wbData = Workbooks(sBookName) If wbData Is Nothing Then Set wbData = Workbooks.Open(sFolderName & sBookName, , True) bOpened = True Err.Clear End If On Error GoTo 0 'On Error GoTo Uffa ' ora il file è aperto, procedo alla lettura dei dati '--- modifica il nome del foglio nel quale effettuare la ricerca Dim sh As Worksheet For Each sh In wbData.Sheets Set wsData = sh Set wsData = wbData.Worksheets("Foglio1") Set wsData = wbData.Worksheets("Foglio2") Set wsData = wbData.Worksheets("Foglio3") Next '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '--- i codici si trovano in colonna B lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row For i = 1 To lLastRow vCode = .Cells(i, 2) 'If vCode = 23797 Then Stop If Len(vCode) Then vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0) If Not IsError(vRow) Then '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value Else '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found") End If End If Next i End With wbData.Close False ' chiudo il file Set wbData = Nothing sBookName = Dir$() ' leggo il prossimo Loop ExitHere: Application.ScreenUpdating = True On Error Resume Next If bOpened Then wbData.Close False Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing Exit Sub Uffa: Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _ CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _ "Codice in elaborazione: " & vCode, _ vbCritical + vbOKOnly, "Error message") Resume ExitHere End Sub
questo è quello che ho sostituito in base alle tue spiegazioni (ripeto che non mi intendo di codice vba) ..
Io non voglio modificare il nome del foglio nel quale effettuare la ricerca...
ma voglio modificare il nome del foglio che contiene i codici da ricercare...
'--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1")
infatti modificando quanto sopra in ("Foglio2") lui mi cerca i codici del Foglio2 dentro tutti i file xls che si trovano dentro la directory controllo.
ripeto che non mi intendo di codice vba
Come?
Scusa, ma allora la macro che c'era nel foglio (che io ho corretto) chi l'ha scritta?
Gibra, una delle tante prove su codici che avevo trovato .. che serviva allo scopo ma non capendo nulla di Vba non capivo gli errori...
ora con te inizio a leggiucchiare Vba e capire come funziona ... certo non sono a zero di informatica.. sono zero di Vba..
Comunque tu hai scritto tutt'altra cosa da quello che ti ho indicato io.
Rileggi bene e con calma il codice che ti ho scritto, quello che hai aggiunto tu non so a cosa serva!
La parte di codice sotto è completamente inutile, non serve a nulla e non capisco perché tu l'abbia aggiunta:`For Each sh In wbData.Sheets Set wsData = sh Set wsData = wbData.Worksheets("Foglio1") Set wsData = wbData.Worksheets("Foglio2") Set wsData = wbData.Worksheets("Foglio3") Next`
Sembra che tu stia scrivendo codice a casaccio.
Devi fare il DEBUG del tuo codice, altrimenti non imparerai mai a sviluppare.
Sembra che tu stia scrivendo codice a casaccio.
Devi fare il DEBUG del tuo codice, altrimenti non imparerai mai a sviluppare.
Inizierò a studiarmi il vba.
grazie gentilissimo.
Imparare a fare il DEBUG è ancora più importante perché ti aiuta ad analizzare il codice, capire gli errori e come risolverli.
Eccoti alcuni link, ma se fai una ricerca DEBUG VBA EXCEL trovi un sacco di materiale:
https://www.excel-easy.com/vba/examples/debugging.html
https://www.techonthenet.com/excel/macros/vba_debug2013.php
https://www.techonthenet.com/excel/macros/vba_debug2016.phpImparare a fare il DEBUG è ancora più importante perché ti aiuta ad analizzare il codice, capire gli errori e come risolverli.
Eccoti alcuni link, ma se fai una ricerca DEBUG VBA EXCEL trovi un sacco di materiale:
https://www.excel-easy.com/vba/examples/debugging.html https://www.techonthenet.com/excel/macros/vba_debug2013.php
https://www.techonthenet.com/excel/macros/vba_debug2016.phpin queste sere andrò a controllare i link ed iniziare ad imparare
Grazie tantissimo dei consigli, sei stato di grande aiuto.
provvedo a chiudere il post, alla fine la soluzione al titolo è stata trovata...
devo solo studiare un po di codice e risolvere il secondo quesito .. un giorno ci riuscirò ..
grazie di tutto.
Gibra, momentaneamente sto tamponando così il problema ... dovrei capire bene come fare il ciclo per non ripetere il codice (in questo caso 3 volte) ma nella realtà sarà per 15 volte...
Sub RiportaDatiCliente() Dim wbData As Workbook Dim wsData As Worksheet Dim rCel As Range Dim sFolderName As String, sBookName As String Dim lColonnaRicerca As Long, lLastRow As Long Dim bOpened As Boolean Dim vRow As Variant, vCode As Variant Dim i As Long '--- parametri ricerca da modifcare sFolderName = ThisWorkbook.Path & "\controllo\" '///sBookName = "fogliocassaXYZ.xls" '//"SUB 123_19.xls" lColonnaRicerca = 3 ' corretto (era 2) '---------------------------------------------- Application.ScreenUpdating = False '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE sBookName = Dir$(sFolderName & "*.xls") Do While sBookName <> "" bOpened = False ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo On Error Resume Next Set wbData = Workbooks(sBookName) If wbData Is Nothing Then Set wbData = Workbooks.Open(sFolderName & sBookName, , True) bOpened = True Err.Clear End If On Error GoTo 0 'On Error GoTo Uffa ' ora il file è aperto, procedo alla lettura dei dati '--- modifica il nome del foglio nel quale effettuare la ricerca Set wsData = wbData.Worksheets("Foglio1") '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '--- i codici si trovano in colonna B lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row For i = 1 To lLastRow vCode = .Cells(i, 2) 'If vCode = 23797 Then Stop If Len(vCode) Then vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0) If Not IsError(vRow) Then '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value Else '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found") End If End If Next i End With '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio2") '--- i codici si trovano in colonna B lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row For i = 1 To lLastRow vCode = .Cells(i, 2) 'If vCode = 23797 Then Stop If Len(vCode) Then vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0) If Not IsError(vRow) Then '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value Else '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found") End If End If Next i End With '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio3") '--- i codici si trovano in colonna B lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row For i = 1 To lLastRow vCode = .Cells(i, 2) 'If vCode = 23797 Then Stop If Len(vCode) Then vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0) If Not IsError(vRow) Then '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value Else '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found") End If End If Next i End With wbData.Close False ' chiudo il file Set wbData = Nothing sBookName = Dir$() ' leggo il prossimo Loop ExitHere: Application.ScreenUpdating = True On Error Resume Next If bOpened Then wbData.Close False Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing Exit Sub Uffa: Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _ CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _ "Codice in elaborazione: " & vCode, _ vbCritical + vbOKOnly, "Error message") Resume ExitHere End Sub
Allegati:
You must be logged in to view attached files.No, stai sbagliando tutto e ti stai complicando la vita inutilmente.
Cosa ti ho scritto nel mio post?
https://www.excelvba.it/forumexcel/forums/discussione/macro-cerca-valore-in-un-file-e-copia-4-celle-adiacenti/#post-18998Rileggi con attenzione.
Il codice che ti ho indicato significa che, DOPO aver aperto il file (WBDATA) per ogni foglio che contiene esegui la modifica.
Invece tu non solo hai mantenuto l'ìistruzione
Set wsData = wbData.Worksheets("Foglio1")
ma addirittura hai replicato tutto il codice 3 volte (cioè per ogni foglio):
Set wsData = wbData.Worksheets("Foglio1") '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '--- With ThisWorkbook.Worksheets("Foglio2") '--- With ThisWorkbook.Worksheets("Foglio3")
--- modifica il nome del foglio nel quale effettuare la ricerca
Set wsData = wbData.Worksheets("Foglio1")
gibra, spe .. riassettiamo un attimo quello che è il mio obiettivo e cosa definisce il codice...
il codice sopra citato "Set wsData = wbData.Worksheets("Foglio1") .. si riferisce al file dei foglicassa giusto? e non al filemaster.xls .. dico bene?? -
AutoreArticoli