[EXCEL] creare macro per raccogliere dati

[raven77]

Ciao a tutti,

sto smadonnando con excel (senza averne le competenze, sigh) perchè devo creare una macro...
allora: ho una serie di file excel (qualche centinaio), tutti simili nella struttura ma con nomi ognuno differente, e devo creare un file riepilogativo che mi vada a leggere da ognuno di questi file alcuni dati in essi contenuti;
i dati che mi servono sono contenuti (anzi, possono essere contenuti... le celle possono risultare anche assenti e/o vuote)
- in celle rinominate univocamente (es: Nome, Cognome, Data1, Data2, FinePeriodo) e contenute tutte nel Foglio1 dei vari file;
- un'altra porzione di dati che mi servono è contenuta in ogni file in una tabella (4 colonne per 20 righe) di cui sono rinominate la prima e l'ultima cella della prima colonna (Inizio e Fine i due nomi); tutte queste tabelle sono contenute nel medesimo foglio (a nome elenco) dei singoli file.

Tutti i file sono raccolti in un'unica cartella sul disco C...

é possibile creare una macro che lavori al posto mio?


p.s.: spero di essere stato chiaro (p.s.: uso excel 2003)

[LarsenB]

Questo è un esempio, molto generico, che fa nella sostanza quello che chiedi... chiaramente tutta la parte centrale di ricerca ed elaborazione di una cella a fronte di un etichetta prefissata va adattata e ampliata a seconda delle tue esigenze specifiche, ma grossomodo il meccanismo sarà analogo; per capire il funzionamento degli oggetti e dei metodi che ho utilizzato, e di quelli che dovrai eventualmente usare tu, puoi fare riferimento alla guida dell'editor di VBA contenuta in Excel

Nota: L'esempio parte dal presupposto che tu abbia Excel con il solo file vuoto di default aperto, che verrà usato per salvare i valori letti dagli altri file aperti e chiusi uno alla volta.

Sub MacroEsempio()

Const XLS_PATH          As String = "C:\MiaCartella\"
Dim fileName            As String
Dim elencoXLS           As Collection
Dim xlsBookResult       As Excel.Workbook
Dim xlsSheetResult      As Excel.Worksheet
Dim xlsBookData         As Excel.Workbook
Dim xlsSheetData        As Excel.Worksheet

Dim xlsFoundCell        As Excel.Range
Dim i                   As Long

'Generiamo l'elenco di tutti i file XLS presenti
 Set elencoXLS = New Collection

fileName = Dir(XLS_PATH & "*.xls")
Do While Len(fileName) > 0
    elencoXLS.Add fileName
    fileName = Dir
Loop

'Se ne abbiamo trovato almeno uno, li apriamo in sequenza
If elencoXLS.Count > 0 Then
    'Il foglio1 del file XLS vuoto che è già aperto sarà quello usato per i risultati
    Set xlsBookResult = Application.ActiveWorkbook
    Set xlsSheetResult = xlsBookResult.Worksheets(1)
   
    For i = 1 To elencoXLS.Count
        fileName = elencoXLS(i)
        Set xlsBookData = Application.Workbooks.Open(XLS_PATH & fileName)
        Set xlsSheetData = xlsBookData.Worksheets(1)
       
        'Un esempio di ricerca della cella basata su un testo fisso ("Totali" in questo caso);
        'trovata la cella con l'intestazione che ci interessa, prendiamo il valore della cella subito a destra e lo
        'copiamo in una nuova cella del foglio di risultato
        Set xlsFoundCell = xlsSheetData.Cells.Find("Totali")
        If Not xlsFoundCell Is Nothing Then
            xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
            xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Next.Value
        End If
       
        'Pulizia
        Set xlsSheetData = Nothing
        xlsBookData.Close False
        Set xlsBookData = Nothing
    Next
   
    'Salvataggio risultato
    xlsBookResult.SaveAs "C:\RISULTATO.XLS"
    MsgBox "Terminato", vbInformation
Else
    MsgBox "nessun file trovato", vbExclamation
End If

End Sub

[raven77]

Come prima cosa GRAZIE per la disponibilità (e la celerità, sopratutto!!)....


adesso veniamo ai problemi: se provo a far girare la tua macro (inserendo il path corretto della cartella e un nome a caso delle celle che mi deve leggere) apre tutti i file ma il file RISULTATO.xls risulta vuoto, senza nulla dentro...

mi sorge il dubbio di non essere riuscito a spiegarmi bene io: le celle (rinominate con "Nome", "Cognome", invece che A1, Z300, ecc.ecc.) che la macro mi deve cercare sono inserite tutte in un foglio nominato PAG1 all'interno dei singoli file...

cambia qualcosa?

[LarsenB]

Come prima cosa GRAZIE per la disponibilità (e la celerità, sopratutto!!)....


adesso veniamo ai problemi: se provo a far girare la tua macro (inserendo il path corretto della cartella e un nome a caso delle celle che mi deve leggere) apre tutti i file ma il file RISULTATO.xls risulta vuoto, senza nulla dentro...

mi sorge il dubbio di non essere riuscito a spiegarmi bene io: le celle (rinominate con "Nome", "Cognome", invece che A1, Z300, ecc.ecc.) che la macro mi deve cercare sono inserite tutte in un foglio nominato PAG1 all'interno dei singoli file...

cambia qualcosa?

Per prima cosa, cambia il fatto che il mio esempio va a cercare il testo nel primo foglio del file, accendendo quindi all'insieme Worksheets per indice (ovvero 1)

Set xlsSheetData = xlsBookData.Worksheets(1)

Nel tuo caso, dovrai invece accedere per chiave, che corrisponde proprio al nome del foglio

Set xlsSheetData = xlsBookData.Worksheets("PAG1")
If xlsSheetData Is Nothing Then
    MsgBox "Foglio 'PAG1' non trovato", vbExclamation
Else
    'hai trovato il foglio che ti interessa
End If

Per quanto riguarda la faccenda delle celle "rinominate", se ho capito bene cosa intendi, ovvero se è stata usata la funzione di Excel "Inserisci nome intervallo" per dare l'etichetta alle celle, allora la cosa potrebbe anche essere più semplice.

Esiste infatti l'insieme Workbook.Names che contiene tutte le etichette dell'intero file, indipendentemente dal foglio... per arrivare alla cella che ti interessa potrebbe quindi bastare, al posto di

Set xlsSheetData = xlsBookData.Worksheets(1)
Set xlsFoundCell = xlsSheetData.Cells.Find("Totali")
If Not xlsFoundCell Is Nothing Then
    xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
    xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Next.Value
End If

qualcosa del genere

Dim n As Name

Set n = xlsBookData.Names("Nome")
If Not n Is Nothing Then
    'hai trovato il nome che ti serve, ora 'RefersToRange' ti 
    'da l'oggetto cella corrispondente
    Set xlsFoundCell= n.RefersToRange
    xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
    xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value
End If
'Ripetere per le altre etichette da cercare

che, incidentalmente, ti risparmia anche di fare la prima correzione suddetta

[radicalnemo]

Scusate intrusione ma che lingua è quello usato per le macro?? trovo manuali?? a me sembra lo stesso che uso con il VB6 sbaglio?

[LarsenB]

Scusate intrusione ma che lingua è quello usato per le macro?? trovo manuali?? a me sembra lo stesso che uso con il VB6 sbaglio?

E' "Visual Basic for Applications", ovvero sostanzialmente VB6 integrato nei prodotti office (e anche alcuni non Microsoft)
I manuali sono dentro Office stesso

[radicalnemo]

E' "Visual Basic for Applications", ovvero sostanzialmente VB6 integrato nei prodotti office (e anche alcuni non Microsoft)
I manuali sono dentro Office stesso

Capisco, grazie mo cerco qualcosa con san google

[LarsenB]

Capisco, grazie mo cerco qualcosa con san google

Se hai un Office qualunque installato, non è che devi cercare troppo...vai su Strumenti->Macro->Editor di Visual basic e sei dentro (vale tanto in Word come in Excel ecc... lo trovi in tutti i moduli principali, l'unico un po' diverso coime concetto è quello presente in Access).

Se l'hai installata c'è anche la guida, se no è sul CD di Office

[radicalnemo]

Sto cercando conto terzi che fa cose complesse ma vedremo io non uso le macro preferisco manipolare i dati tramite c#

[tibia_5]

Ciao Larsen, avrei bisogno d'aiuto sulla macro che hai creato qui sopra, io l'ho creata, ma mi continua a dire "nessun file trovato".
Ecco cosa ho fatto:
ho messo tutti i file in una cartella sul desktop;
Ho nominato i fogli in cui deve cercare i dati che mi servono tutti allo stesso modo;
ho copiato la macro come hai consigliato tu e apportato delle modifiche.
ecco la macro modificata:
Sub database()

Const XLS_PATH As String = "C:\Users\Power\Desktop"
Dim fileName As String
Dim elencoXLS As Collection
Dim xlsBookResult As Excel.Workbook
Dim xlsSheetResult As Excel.Worksheet
Dim xlsBookData As Excel.Workbook
Dim xlsSheetData As Excel.Worksheet

Dim xlsFoundCell As Excel.Range
Dim i As Long

'Generiamo l'elenco di tutti i file XLS presenti
Set elencoXLS = New Collection

fileName = Dir(XLS_PATH & "*.xls")
Do While Len(fileName) > 0
elencoXLS.Add fileName
fileName = Dir
Loop

'Se ne abbiamo trovato almeno uno, li apriamo in sequenza
If elencoXLS.Count > 0 Then
'Il foglio1 del file XLS vuoto che è già aperto sarà quello usato per i risultati
Set xlsBookResult = Application.ActiveWorkbook
Set xlsSheetResult = xlsBookResult.Worksheets("nomi")

For i = 1 To elencoXLS.Count
fileName = elencoXLS(i)
Set xlsBookData = Application.Workbooks.Open(XLS_PATH & fileName)
Dim n As Name

Set n = xlsBookData.Names("contatti")
If Not n Is Nothing Then
'hai trovato il nome che ti serve, ora 'RefersToRange' ti
'da l'oggetto cella corrispondente
Set xlsFoundCell = n.RefersToRange
xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value
End If


'Pulizia
Set xlsSheetData = Nothing
xlsBookData.Close False
Set xlsBookData = Nothing
Next

'Salvataggio risultato
xlsBookResult.SaveAs "C:\RISULTATO.XLS"
MsgBox "Terminato", vbInformation
Else
MsgBox "nessun file trovato", vbExclamation
End If


End Sub

Mi iusciresti a dare una mano??? Grazie mille!!!

[LarsenB]

Ciao Larsen, avrei bisogno d'aiuto sulla macro che hai creato qui sopra, io l'ho creata, ma mi continua a dire "nessun file trovato".

guarda questa riga della macro:

fileName = Dir(XLS_PATH & "*.xls")

e poi guarda come hai definito la costante XLS_PATH; confronta con la costante del mio esempio più sopra....

Se non fai terminare il percorso con \ , non troverà mai nessun file...

[tibia_5]

Ciao e grazie mille per avermi risposto....forse ho individuato il problema (era come dicevi tu), ma mi succede una cosa:ho evidenziato il range di dati da prendere in considerazione con la funzione "inserisci nome intervallo". Quando nel codice ci metto il nome dell'intervallo, però mi importa solo il primo valore. Non sai come devo fare per importare tutto il range?

Grazie ancora

[LarsenB]

Ciao e grazie mille per avermi risposto....forse ho individuato il problema (era come dicevi tu), ma mi succede una cosa:ho evidenziato il range di dati da prendere in considerazione con la funzione "inserisci nome intervallo". Quando nel codice ci metto il nome dell'intervallo, però mi importa solo il primo valore. Non sai come devo fare per importare tutto il range?

Grazie ancora

Non sono sicuro di seguirti, stiamo parlando di una cosa di 9 mesi fa e non so nemmeno se con questa macro adesso stai facendo la stessa cosa chiesta a suo tempo dall'OP...

Se stai parlando del risultato della funzione .Names("<nome>"), questa restituisce un oggetto Range, che può essere di una o di più celle... se vuoi leggere il contenuto di tutte ovviamente non defi vare riferimento direttamente a .Value, ma devi ciclare l'insieme .Cells, e leggere il valore da ciascun oggetto presente li.

[tibia_5]

Hai colto bene il mio problema....io praticamente da questa macro devo estrarre i dati di un range presente in vari file. Quindi a questo codice, dove dico di riciclare l'insieme.Cells???

Sub database()

Const XLS_PATH As String = "C:\Users\Power\Desktop\aziende\"
Dim fileName As String
Dim elencoXLS As Collection
Dim xlsBookResult As Excel.Workbook
Dim xlsSheetResult As Excel.Worksheet
Dim xlsBookData As Excel.Workbook
Dim xlsSheetData As Excel.Worksheet

Dim xlsFoundCell As Excel.Range
Dim i As Long

'Generiamo l'elenco di tutti i file XLS presenti
Set elencoXLS = New Collection

fileName = Dir(XLS_PATH & "*.xls")
Do While Len(fileName) > 0
elencoXLS.Add fileName
fileName = Dir
Loop

'Se ne abbiamo trovato almeno uno, li apriamo in sequenza
If elencoXLS.Count > 0 Then
'Il foglio1 del file XLS vuoto che è già aperto sarà quello usato per i risultati
Set xlsBookResult = Application.ActiveWorkbook
Set xlsSheetResult = xlsBookResult.Worksheets(2)

For i = 1 To elencoXLS.Count
fileName = elencoXLS(i)
Set xlsBookData = Application.Workbooks.Open(XLS_PATH & fileName)
Dim n As Name

Set n = xlsBookData.Names("contatti")
If Not n Is Nothing Then
'hai trovato il nome che ti serve, ora 'RefersToRange' ti
'da l'oggetto cella corrispondente
Set xlsFoundCell = n.RefersToRange
xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value
End If
'Ripetere per le altre etichette da cercare


'Pulizia
Set xlsSheetData = Nothing
xlsBookData.Close False
Set xlsBookData = Nothing
Next

'Salvataggio risultato
xlsBookResult.SaveAs "C:\Users\Power\Desktop\RISULTATO.xls"
MsgBox "Terminato", vbInformation
Else
MsgBox "nessun file trovato", vbExclamation
End If

End Sub

Te ne sarei veramente grato se riuscissi ad aiutarmi....

[LarsenB]

Hai colto bene il mio problema....io praticamente da questa macro devo estrarre i dati di un range presente in vari file. Quindi a questo codice, dove dico di riciclare l'insieme.Cells???

"ciclare", non "riciclare": devi fare un altro ciclo For...
Dove? nell'unico punto in cui leggi il .Value del range che hai trovato...

[tibia_5]

scusa...ciclare....:(
non so però come farlo praticamente, pertanto ho capitoche il punto del codice interessato è questo:
Dim n As Name

Set n = xlsBookData.Names("contatti")
If Not n Is Nothing Then
'hai trovato il nome che ti serve, ora 'RefersToRange' ti
'da l'oggetto cella corrispondente
Set xlsFoundCell = n.RefersToRange
xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value
End If
'Ripetere per le altre etichette da cercare
ma non so come modificarlo. Pertanto se me lo puoi scrivere te ne sarei infinitamente grato, altrimenti grazie lo stesso e farò come facevano gli antichi.....

[LarsenB]

scusa...ciclare....:(
non so però come farlo praticamente, pertanto ho capitoche il punto del codice interessato è questo:
Dim n As Name

Set n = xlsBookData.Names("contatti")
If Not n Is Nothing Then
'hai trovato il nome che ti serve, ora 'RefersToRange' ti
'da l'oggetto cella corrispondente
Set xlsFoundCell = n.RefersToRange
xlsSheetResult.Cells(i, 1).Value = "File " & fileName & ":"
xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value
End If
'Ripetere per le altre etichette da cercare
ma non so come modificarlo. Pertanto se me lo puoi scrivere te ne sarei infinitamente grato, altrimenti grazie lo stesso e farò come facevano gli antichi.....

Hai detto che il problema è che leggi un solo valore dall'intervallo trovato: nel tuo codice c'è un'unica istruzione in cui prendi il valore di una cella per copiarla in un altra, ed è la riga

xlsSheetResult.Cells(i, 2).Value = xlsFoundCell.Value

Se, per come hai messo le etichette, "contatti" è un insieme di celle e non una cella singola, allora xlsFoundCell sarà un oggetto Range che a sua volta contiene altri oggetti Range singoli; come dicevo quindi devi scorrerli tutti e leggere il valore di ciascuno, ovvero

(In alto insieme alle altre dichiarazioni)
Dim tempRange As Excel.Range

(e , al posto della riga incriminata, qualcosa di simile a)

For Each tempRange In xlsFoundCell.Cells
<qualcosa> = tempRange.Value
Next

Il codice esatto non sono in grado di metterlo perchè non ho idea ne' di come sono definiti esattamente i valori nel foglio originale, nè di come tu li voglia riorganizzare in quello nuovo...