Estrazione dati con macro

Hai un problema con Excel?

Nuova discussione

Estrazione dati con macro
di save#5 (utente non iscritto) data: 04/08/2015 15:19:06
Ciao a tutti vi chiedo questa cosa dal mio punto di vista complicata ma magari per voi è facile.
Ho una serie di file excel (più di 300) praticamente uguali stesso format ma con valori diversi ovviamete (vi allego l'esempio del format).
C'è una macro che mi estrae in maniera veloce solo i valori che mi interessano su un altro foglio senza stare a copiare a mano ogni volta tali valori per risparmiare tempo???
Le celle dei valori che mi interessano sono le seguenti:
C3;C4;C5;D7;J7;I10;J14.
di alfrimpa data: 04/08/2015 16:20:07
Ciao Save

In pratica tu devi aprire ognuno dei 300 e più file, copiare le celle (sono tutte nel foglio1?) ed incollarle in una nuova cartella su di un foglio accodando i dati in modo da costituire un "database"?

Alfredo
di save#5 (utente non iscritto) data: 04/08/2015 16:41:37
Ciao Alfrimpa

esatto,
devo aprire tutti i file copiare i contenuti delle celle che mi servono (che sono quelli che vi ho indicato, tutte nel foglio 1) e copiarli su di un altro foglio dove ho gia predisposto dei calcoli.
Ovviamente farlo a mano ci metto una vita.
Chiedevo se ci fosse una macro che mi velocizzasse almeno l'estrazione dei dati in maniera veloce.

Tu riesci a darmi una soluzione???
Ti ringrazio anticipatamente.
di alfrimpa data: 04/08/2015 16:55:17
Ho fatto qualcosa del genere tempo fa e non so se riesco a ritrovare il codice; se non ci riesco devo ricostruirlo e ci vorrà un po' di tempo.

Alfredo
di save#5 (utente non iscritto) data: 04/08/2015 17:06:13
Ok

Quando riesci a trovarlo o a farlo io sarò qui che aspetto, perchè non so più dove sbattere la testa.
di Vecchio Frac data: 04/08/2015 18:26:16
cit. "Chiedevo se ci fosse una macro"
---> Non c'è, te la devi costruire.

cit. "Quando riesci a trovarlo o a farlo io sarò qui che aspetto"
---> Atteggiamento sbagliato, rischi di aspettare ^_^
Provaci! Sbattiti un pochino. Esiste l'oggetto FileSystemObject per recuperare, col suo metodo GetFolder e Files, tutti i file contenuti in una cartella. Esistono i cicli For Each che servono a scandagliare gli elementi di un insieme. Esiste il metodo Open per aprire un file e Close per chiuderlo. Esistono i riferimenti di cella (Range o Cells) per individuare una zona del foglio. Esistono i metodi "Copy destinazione" o "Copy" + "PasteSpecial" per trasferire contenuti da una zona a un'altra.
Ecco ,ti ho dato la soluzione... prova ad applicarla al tuo caso ^_^
di alfrimpa data: 04/08/2015 18:42:20
Anche perchè "sbattersi" con questo caldo quando non sei il diretto interessato non è il massimo

@ Save#5

Fai tesoro delle indicazioni di Vecchio Frac e prova ad affrancarti dalla dipendenza da forum; solo in questo modo imparerai concretamente.

Alfredo
di save#5 (utente non iscritto) data: 04/08/2015 18:43:16
Ciao vecchio frac

Posso essere d'accordo cn te che dovrei sbattersi, ma purtroppo ho mille cose da fare a lavoro e non essendo un informatico e un esperto di via anche se ci provassi a sbattermi nn ci riuscirei. Gli oggetti che hai menzionato non ho la più pallida idea di cosa siano in quanto come ti ho detto prima non sono un informatico. Per cui mi sono rivolto ad un team di esperti come voi per avere un aiuto. Ora se me lo volete dare vi sarei molto grato, al contrario se nn volete aiutarmi va benissimo lo stesso vi ringrazio lo stesso della vostra disponibilità.

Ripeto non ho proprio le competenze per fare una macro e non ho neanche il tempo per impararle (cosa che farei se avessi del tempo). Voi invece siete degli esperti e quindi ho solo chiesto un aiuto.

Vi ringrazio ancora.
di alfrimpa data: 04/08/2015 19:01:05
Perdonami Save ma questo non è il modo giusto di approcciarsi ad un forum che non può essere utilizzato come un juke-box che fornisce soluzioni pronte a richiesta.

A mio avviso chi pone quesiti deve anche dimostrare un minimo di buona volontà ed impegno; tu dici di non avere tempo ma questo non è un buon motivo per giustificare questo atteggiamento.

Se non hai tempo hai alternative come quella di rivolgerti a professionisti che fanno questo di mestiere.

Su questo forum (tra quelli che di solito rispondono) non ci sono informatici di professione ma solo appassionati che comunque hanno dovuto impegnarsi a studiare per acquisire le conoscenze che hanno, cosa che tu, mi pare, non sei disposto a fare.

Comunque quanto sopra è solo la mia opinione.

Alfredo
di save#5 (utente non iscritto) data: 04/08/2015 19:17:19
Io nn voglio e nn volevo assolutamente offendere nessuno cn quanto detto prima. Ammiro il vostro impegno e la vostra dedizione. Assolutamente nn é mio intento utilizzare questo forum cm jubox. Ho solo detto che avendo mancanza di conoscenza teorica di vba cercavo un aiuto.
Io provo a fare da solo infatti grazie ai vostri suggerimenti ho risolto molti casi che mi sono presentati. Ma adesso però si tratta di programmazione vba che per me è troppo e quindi per questo volevo avere un esempio di soluzione da poter poi magari riutilizzare in altri casi diversi.

Cmq detto cio ringrazio tutti lo stesso.
Buona serata a tutti

di Raffaele_53 data: 04/08/2015 20:17:19
Questo il codice
Apri un file nuovo, inserisci il codice in un modulo e lo salvi nella stessa cartella dei 300 con nome test.Xlsm (funziona se tutti gli altri sono in foglio1)

Sub copia()
    Dim Sh1 As Worksheet
    Dim Fpath As String, nomeFile As String, Rg As Long
    Fpath = ThisWorkbook.Path & ""
    Application.ScreenUpdating = False
    Rg = 1
    Set Sh1 = ThisWorkbook.Worksheets("Foglio1")
    Sh1.Cells.ClearContents
    nomeFile = Dir(Fpath)
Inizia:
        If nomeFile = "" Then GoTo Fine
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Fpath & "" & nomeFile)
            Sh1.Cells(Rg, 1) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C3")
            Sh1.Cells(Rg, 2) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C4")
            Sh1.Cells(Rg, 3) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C5")
            Sh1.Cells(Rg, 4) = Workbooks(nomeFile).Worksheets("Foglio1").Range("D7")
            Sh1.Cells(Rg, 5) = Workbooks(nomeFile).Worksheets("Foglio1").Range("J7")
            Sh1.Cells(Rg, 6) = Workbooks(nomeFile).Worksheets("Foglio1").Range("I10")
            Sh1.Cells(Rg, 7) = Workbooks(nomeFile).Worksheets("Foglio1").Range("J14")
            Workbooks(nomeFile).Close False
            Rg = Rg + 1
        End If
        nomeFile = Dir
        GoTo Inizia
Fine:
    Application.ScreenUpdating = True
    MsgBox "Fatto"
    Set Sh1 = Nothing
End Sub

di Vecchio Frac data: 04/08/2015 21:54:39
Bè, io volevo solo fornire uno spunto per inziiare a curiosare nella programmazione VBA.
Raffaele ha fatto la sua proposta senza usare FileSystemObject ma Dir: diciamo che si tratta di uno stile diverso (io non riesco proprio a vederlo il codice con i goto, ma pazienza ^_^ ... VBA non è GWBASIC)

di Raffaele_53 data: 05/08/2015 00:41:31
Ciao VF
Non desideravo impegnarmi più di tanto, comunque ...

Sub copia()
    Dim Sh1 As Worksheet
    Dim Fpath As String, nomeFile As String, Rg As Long
    Fpath = ThisWorkbook.Path & ""
    Application.ScreenUpdating = False
    Rg = 1
    Set Sh1 = ThisWorkbook.Worksheets("Foglio1")
    Sh1.Cells.ClearContents
    nomeFile = Dir(Fpath)
    Do While nomeFile <> "" And nomeFile <> ThisWorkbook.Name
            Workbooks.Open (Fpath & "" & nomeFile)
            Sh1.Cells(Rg, 1) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C3")
            Sh1.Cells(Rg, 2) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C4")
            Sh1.Cells(Rg, 3) = Workbooks(nomeFile).Worksheets("Foglio1").Range("C5")
            Sh1.Cells(Rg, 4) = Workbooks(nomeFile).Worksheets("Foglio1").Range("D7")
            Sh1.Cells(Rg, 5) = Workbooks(nomeFile).Worksheets("Foglio1").Range("J7")
            Sh1.Cells(Rg, 6) = Workbooks(nomeFile).Worksheets("Foglio1").Range("I10")
            Sh1.Cells(Rg, 7) = Workbooks(nomeFile).Worksheets("Foglio1").Range("J14")
            Workbooks(nomeFile).Close False
            Rg = Rg + 1
            nomeFile = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
    Set Sh1 = Nothing
End Sub

di Vecchio Frac data: 05/08/2015 07:31:02
@raffaele
+1
^_^
di save#5 (utente non iscritto) data: 05/08/2015 09:05:46
Scusate se interrompo le vostre discussioni. Una volta copiato il codice quando lo eseguo non mi estrae i valori.
Come si deve fare???
di save#5 (utente non iscritto) data: 05/08/2015 10:34:36
Mitico Raffaele_53,
la tua macro funziona perfettamente.
Grazie mille dell'aiuto prezioso.

di Vecchio Frac data: 05/08/2015 14:51:53
Aggiungo la mia solo per curiosità scientifica ^_^

Option Explicit

Sub copy_from_many()
Dim f As Object, wbk1 As Workbook, wbk2 As Workbook, rg As Long, col As Long, area As Range

    Application.ScreenUpdating = False
    Set wbk1 = ThisWorkbook
    For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "").Files
        If Left(f.Name, 1) <> "~" And (Right(f.Name, Len(f.Name) - InStrRev(f.Name, ".")) Like "*xl*") And (f.Name <> ThisWorkbook.Name) Then
            Set wbk2 = Workbooks.Open(f)
            rg = rg + 1
            col = 0
            For Each area In wbk2.Sheets("Foglio1").Range("C3, C4, C5, D7, J7, I10, J14").Areas
                col = col + 1
                wbk1.Sheets("Foglio1").Cells(rg, col) = area
            Next
            wbk2.Close False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

di Raffaele_53 data: 05/08/2015 17:12:12
curiosità scientifica ^_^
>>>Set wbk1 = Nothing
>>>Set wbk2 = Nothing
Bello comunque
di Vecchio Frac data: 05/08/2015 17:51:11
@raffaele
+2
^_^

Vuoi Approfondire?