Condividi:        

Aiuto x macro excel copia dati file e incolla su altro file

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Aiuto x macro excel copia dati file e incolla su altro file

Postdi mlux81 » 02/03/18 17:13

Anthony mi ha già aiutato per l'importazione dei dati da web in questa discussione viewtopic.php?t=108964

Premesso che non ho molta dimistichezza con excel se non per le funzioni di base e non ho nessuna conoscenza di programmazione ma avrei necessità di creare una macro per una operazione di cerca, copia su un file e incolla su altro file di determinati dati.

In pratica, in un primo file (elenco varietà) ho un solo foglio con 4 colonne e 345 righe in cui nella prima colonna c'è un rifeirmento numerico (es. 133827) da ricercare nel 2° file (price guide).
Quindi nel primo file (elenco varietà) creare tanti altri fogli per ogni riferimento numerico della prima colonna da ricercare nel secondo foglio e nominare ogni foglio con il testo contenuto nelle colonne b-c-d del primo file.

Il secondo file è quello da cui attingere i dati ed è composto da più fogli. Dovrei quindi cercare su tutti i fogli del 2° file il riferimento numerico del primo file e copiare tutte le corrispondenti righe (solo i dati contenuti nelle colonne c-d-e-f-g-h-j ed escludendo a-b-i) ed incollare con la stessa formattazione (dovrei variare solo la formattazione della colonna C del 2° file che diventerebbe la colonna A nel 1° file da euro a USD $) sul nuovo foglio di riferimento creato nel primo file, adattando la larghezza della colonna al contenuto.
Quest'ultima operazione deve essere fatta per ogni riferimento numerico/nuovo foglio del primo file.

Spero di essere riuscito a spiegarmi ed allego files di prova.

Il secondo file essendo di circa 45 mb, ho estratto solo alcuni fogli per prova. Pertanto eventualemnte provare a ricercare solo alcuni riferimenti numerici corrispondenti alle date 1878 (1878 7/8TF, 1878 8TF e 1878-S).

Ringrazio anticipatamente a chi volesse darmi una mano d'aiuto.
Grazie

file 1: https://ufile.io/yaii8

file 2: https://ufile.io/ladw0
mlux81
Utente Junior
 
Post: 24
Iscritto il: 06/09/17 10:48

Sponsor
 

Re: Aiuto x macro excel copia dati file e incolla su altro f

Postdi Anthony47 » 04/03/18 00:44

La prima cosa puo' essere ottenuta con una macro come questa, da inserire nel vba del primo file, "elenco varietà":
Codice: Seleziona tutto
Sub Cioppa()
Dim oArr(), wArr, LastA As Long, I As Long, J As Long, lFor
Dim tWb As Workbook, cRow As Long, C As Range, K As Long, Y As Long
'
Set tWb = Workbooks("byMLUX81_PROGa_file-2_B80303.xlsx")    '<<< Il nome del Secondo file
'
ThisWorkbook.Activate
LastA = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(LastA, 1).Value
tWb.Activate
For I = 1 To UBound(wArr)
    ReDim oArr(1 To 10, 1 To 1): Y = 0
    Set C = Nothing
    lFor = wArr(I, 1)
    For J = 1 To tWb.Sheets.Count
        With Sheets(J).Range("B:B")
            Set C = .Find(lFor, LookIn:=xlValues)
            If Not C Is Nothing Then
                firstAddress = C.Address
                Do
                    Y = Y + 1
                    cRow = C.Row
                    For K = 1 To 10
                    If K = 3 Or K = 4 Then
                        oArr(K, Y) = CLng(Sheets(J).Cells(cRow, K))
                    Else
                        oArr(K, Y) = Sheets(J).Cells(cRow, K)
                    End If
                    Next K
                    ReDim Preserve oArr(1 To 10, 1 To Y + 1)
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> firstAddress
            End If
        End With
    Next J
    If Y > 0 Then
        ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = lFor
        ThisWorkbook.Sheets(lFor & "").Range("A1").Resize(Y + 1, 10).Value = Application.WorksheetFunction.Transpose(oArr)
        ThisWorkbook.Sheets(lFor & "").Columns("C:C").NumberFormat = "[$-410]d-mmm-yy;@"
        ThisWorkbook.Sheets(lFor & "").Columns("D:D").NumberFormat = "[$$-409]#,##0.00"
    End If
''If ThisWorkbook.Sheets.Count > 20 Then Stop
Next I
Set tWb = Nothing
MsgBox ("Completato...")
End Sub
La riga marcata <<< va modificata con il nome del secondo file (price guide)

All'occorrenza va aperto il "secondo file" e lanciata la Sub Cioppa.

La macro cerchera' ogni valore di colonna A di Foglio1 del "primo file" all'interno di colonna B di ogni foglio del secondo file; se lo trova riporta in un nuovo foglio (che sara' inserito all'interno del "primo file") i dati di colonna A:J delle righe trovate.
Se ci sono delle colonne che non si vuole vedere esse possono essere nascoste o eliminate con una macro autoregistrata, da lanciare in coda alla Sub Cioppa.
Il nuovo foglio in "primo file" avra' come nome il solo contenuto di colonna A.
Tuttavia ti anticipo che il forum non puo' preparare all'infinito soluzioni finite, soprattutto se non si tratta di hobby.

Per queste situazioni il mio suggerimento e' che ti rivolgi a un programmatore che sara' ben lieto di aiutare.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aiuto x macro excel copia dati file e incolla su altro f

Postdi mlux81 » 04/03/18 17:53

Anthony47 ha scritto:La prima cosa puo' essere ottenuta con una macro come questa, da inserire nel vba del primo file, "elenco varietà":

La riga marcata <<< va modificata con il nome del secondo file (price guide)

All'occorrenza va aperto il "secondo file" e lanciata la Sub Cioppa.

La macro cerchera' ogni valore di colonna A di Foglio1 del "primo file" all'interno di colonna B di ogni foglio del secondo file; se lo trova riporta in un nuovo foglio (che sara' inserito all'interno del "primo file") i dati di colonna A:J delle righe trovate.
Se ci sono delle colonne che non si vuole vedere esse possono essere nascoste o eliminate con una macro autoregistrata, da lanciare in coda alla Sub Cioppa.
Il nuovo foglio in "primo file" avra' come nome il solo contenuto di colonna A.
Tuttavia ti anticipo che il forum non puo' preparare all'infinito soluzioni finite, soprattutto se non si tratta di hobby.

Per queste situazioni il mio suggerimento e' che ti rivolgi a un programmatore che sara' ben lieto di aiutare.

Ciao


Ti ringrazio come sempre per l'aiuto e mi scuso se chiedo sempre soluzioni finite come dici tu, ma ti assicuro che sono un collezionista di Dollari Morgan con particolare riferimento ai VAM e pertanto non serve per altro ma solo per il mio hobby di collezionista di questo particolare tipo di monete.

In merito al codice che mi hai fornito ho fatto la prova sui due file che ho messo nella prima discussione e funziona perfettamente con l'unica problema che non incolla con la stessa formattazione (avrei in particolare necessità della stessa formattazione per la colonna H per incollare lo stesso link cliccabile).
Tuttavia quando ho provato il codice sul file di 45 mb mi da un errore in questo punto
oArr(K, Y) = CLng(Sheets(J).Cells(cRow, K)) e non inizia la ricerca.
mlux81
Utente Junior
 
Post: 24
Iscritto il: 06/09/17 10:48

Re: Aiuto x macro excel copia dati file e incolla su altro f

Postdi Anthony47 » 05/03/18 00:24

mlux81 ha scritto: [. . .] ti assicuro che sono un collezionista di Dollari Morgan con particolare riferimento ai VAM [. . .]
Eh, come e' noto anche gli hobby sono costosi...

Per quanto riguarda i link cliccabili, li ho aggiunti.

Quanto all'errore che ottieni quando vai sul file completo, immagino che dia un messaggio di "Tipo non corrispondente"; la mia migliore ipotesi e' che il tuo file in alcune posizioni non contiene una data o una quotazione (in colonne C e D). Ho modificato la macro affinche' salti queste situazioni di errore e le riporti nella "finestra Immediata" del vba.

Il nuovo codice per la Sub Cioppa:
Codice: Seleziona tutto
Sub Cioppa()
Dim oArr(), wArr, LastA As Long, I As Long, J As Long, lFor
Dim hyArr()
Dim tWb As Workbook, cRow As Long, C As Range, K As Long, Y As Long
'
Set tWb = Workbooks("byMLUX81_PROGa_file-2_B80303.xlsx")    '<<< Il nome del Secondo file
'
ThisWorkbook.Activate
LastA = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(LastA, 1).Value
tWb.Activate
For I = 1 To UBound(wArr)
    ReDim hyArr(1 To 10, 1 To 1)
    ReDim oArr(1 To 10, 1 To 1): Y = 0
    Set C = Nothing
    lFor = wArr(I, 1)
    For J = 1 To tWb.Sheets.Count
        With Sheets(J).Range("B:B")
            Set C = .Find(lFor, LookIn:=xlValues)
            If Not C Is Nothing Then
                firstAddress = C.Address
                Do
                    Y = Y + 1
                    cRow = C.Row
                    For K = 1 To 10
                        If Sheets(J).Cells(cRow, K).Hyperlinks.Count > 0 Then
                            hyArr(K, Y) = Sheets(J).Cells(cRow, K).Hyperlinks(1).Address
                        End If
                        If K = 3 Or K = 4 Then
                            If IsNumeric(Sheets(J).Cells(cRow, K)) Or IsDate(Sheets(J).Cells(cRow, K)) Then
                                oArr(K, Y) = CLng(Sheets(J).Cells(cRow, K))
                            Else
                                Debug.Print Sheets(J).Name, cRow, K
                            End If
                        Else
                            oArr(K, Y) = Sheets(J).Cells(cRow, K)
                        End If
                    Next K
                    ReDim Preserve oArr(1 To 10, 1 To Y + 1)
                    ReDim Preserve hyArr(1 To 10, 1 To Y + 1)
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> firstAddress
            End If
        End With
    Next J
    If Y > 0 Then
        ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = lFor
        ThisWorkbook.Sheets(lFor & "").Range("A1").Resize(Y + 1, 10).Value = Application.WorksheetFunction.Transpose(oArr)
        For J = 1 To UBound(hyArr)
            For K = 1 To UBound(hyArr, 2)
                If hyArr(J, K) <> "" Then
                    ThisWorkbook.Sheets(lFor & "").Hyperlinks.Add anchor:= _
                      ThisWorkbook.Sheets(lFor & "").Cells(K, J), Address:=hyArr(J, K), _
                      ScreenTip:="Vedi"
                End If
            Next K
        Next J
        ThisWorkbook.Sheets(lFor & "").Columns("C:C").NumberFormat = "[$-410]mmm-yy;@"
        ThisWorkbook.Sheets(lFor & "").Columns("D:D").NumberFormat = "[$$-409]#,##0.00"
    End If
''If ThisWorkbook.Sheets.Count > 20 Then Stop
Next I
Set tWb = Nothing
ReDim oArr(1 To 1)
ReDim hyArr(1 To 1)
MsgBox ("Completato...")
End Sub

Completato il lavoro devi ispezionare la finestra Immediata del vba per eventuali situazioni di errore:
-da Excel, apri il vba con i tasti Alt-F11
-ora puoi aprire la finestra Immediata con i tasti Contr-g

Potresti avere un elenco del tipo
NomeFoglio NumeroRiga NumeroColonna

Controlla che su quel foglio, quella riga e quella colonna contengano un valore sintatticamente corretto e che sia una data (colonna C) o un valore numerico (colonna D)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aiuto x macro excel copia dati file e incolla su altro f

Postdi mlux81 » 05/03/18 16:05

Grazie Anthony. Funziona perfettamente.
Ho ispezionato la finestra immediata del vba come mi hai consigliato ma non c'era niente.
mlux81
Utente Junior
 
Post: 24
Iscritto il: 06/09/17 10:48


Torna a Applicazioni Office Windows


Topic correlati a "Aiuto x macro excel copia dati file e incolla su altro file":


Chi c’è in linea

Visitano il forum: Nessuno e 60 ospiti