› Sviluppare funzionalita su Microsoft Office con VBA › Unire fogli con selezione colonne
-
AutoreArticoli
-
Buonasera Forum,
chiedo supporto per risolvere un problema cui non trovo soluzione.
Ho un file in Excel che contiene 3 fogli di settantatre colonne, i primi due di 5000 righe e il terzo di 15000 che per lavoro ho necessità di unire almeno una volta al giorno.
Le colonne da copiare nel foglio Riepilogo sono sempre le stesse, ma non si trovano nella stessa posizione, per cui sono costretto manualmente a fare il copia incolla, e, per la fretta, mi capita anche di sbagliare le ventuno selezioni.
Ho cercato a lungo su internet ma la cosa più vicina alle mie esigenze e quello che esegue l'allegato file che non ho idea di come modificare per snellire la mia attività e la discussione nel forum Macro copia incolla range.
Grazie.
Allegati:
You must be logged in to view attached files.Buona sera vecchio frac,
le colonne da copiare sono note a priori e come nel file allegato non sono nei tre fogli nella stessa posizione il risultato finale che vorrei ottenere è:
colonna 1 foglio 1 - colonna 2 foglio 1 - colonna 3 foglio 1 ecc
colonna 1 foglio 2 - colonna 2 foglio 2 - colonna 3 foglio 2 ecc
colonna 1 foglio 3 - colonna 2 foglio 3 - colonna 3 foglio 3 ecc
Salve a tutti
col permesso di Vecchio Frac (un caro saluto) ti suggerisco questa macro
Sub Riporta_Ordine() Dim a As Long, k As Long, i As Long, j As Long, cn As Long Dim dato As String, matrice As String Sheets("Consolidato").Cells.ClearContents a = 1 For k = 1 To Sheets.Count ur = Sheets(k).Cells(Rows.Count, 1).End(xlUp).Row uc = Sheets(k).Cells(2, Columns.Count).End(xlToLeft).Column - 1 If Sheets(k).Name = "Sheet" & k Then For i = 2 To ur a = a + 1 For j = 1 To uc dato = "colonna " & j & " Foglio " & k & "" matrice = "Sheet" & k intervallo = "A" & i & ":K" & i On Error Resume Next cn = Application.WorksheetFunction.Match(dato, Sheets(matrice).Range(intervallo), 0) If cn = 0 Then dato = "": Exit For On Error GoTo 0 Sheets("Consolidato").Cells(a, j) = Sheets(k).Cells(i, cn) Next j Next i End If dato = "" matrice = "" intervallo = "" a = a + 1 Next k End Sub
Fa quello che chiedi. Attento che colonna 8 e Fogliox è errato; deve essere colonna 8 Foglio x
Allego il file in cui ho aggiunto un Foglio per non inficiare il tuo lavoro.
Fai sapere. Ciao,
Mario
Allegati:
You must be logged in to view attached files.col permesso di Vecchio Frac
Bè perchè "col permesso"?
Tutti possono intervenire liberamente... certo come sai da inizio anno ho deciso di guidare gli utenti alla soluzione piuttosto che fornirla, ma è solo un mio metodo, non implica niente, e tu Supermario fai benissimo a contribuire.
Se vuoi l'unica osservazione che ti faccio è questa: è ridondante scrivere "Application.WorksheetFunction.Match" poichè è sufficiente: "Application.Match" oppure "WorksheetFunction.Match".
@marius
Rispetto alla tua soluzione mi permetto di farti un paio di osservazioni:
- non è che il nostro interlocutore intende copiare il contenuto delle colonne da spostare, piuttosto che la descrizione della loro posizione? cioè, se io inserisco qualcosa al posto di "colonna 1 Foglio 1", per esempio "pippo", mi aspetto di ritrovare "pippo" nel foglio di riepilogo, o sbaglio?
- nella tua proposta mancano le celle finali (quelle che nel file originale riportano le voci di "test")?
Ho provato il codice esistente nel tuo file, "Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()", e produce il risultato del foglio "Consolidate data", ed è errato vero?
In merito a quello che dicevo a Supermario, cosa ci dici? vorresti il contenuto o la descrizione delle colonne? comprese le celle finali (con "test") o no? e se sì, quante dovrebbero essere: l'intera riga o alcune celle specifiche?
Ciao
@Vecchio Frac
OK per quanto riguarda la ridondanza (non riesco a togliermi l'abitudine di scrivere per esteso)
In merito al "contenuto" delle colonne, avrai notato che la mia variabile dato è composta da
= "colonna " & j & " Foglio " & k & ""
dove basta cambiare quello fra i doppi apici ed il risultato è (dovrebbe essere) quello voluto.
Nel file da me allegato (come detto ho aggiunto u Foglio) ho cancellato le stringe "test" in tutti i Fogli perchè altrimenti la conta delle colonne da copiare viene sfalsata e ripete per molte volte l'ultimo dato.
Ciao,
Mario
Buonasera Forum e grazie le gentili risposte.
Rispondo ai quesiti di vecchio frac.
Le colonne dei tre fogli sono 73 e complessivamente sono non meno di 25.000 righe.
Quelle di cui mi interessa importare il contenuto testo e numeri, ci può essere "pippo" o "pluto" oppure "0", "11" o "-21" ecc, sono per il momento 20.
Le venti colonne sono in posizione diverse nei tre fogli come nel file che ho allegato e quello "Cosolidate_Data" è effettivamente sbagliato
Il primo rigo dei tre fogli contiene le intestazioni delle colonne, la prima colonna contiene codice cliente, ma sono dati che non servono.
La copia dei dati nel foglio "consolida" dovrebbe iniziare dalla cella "B2" senza lasciare righe vuote.
Mi scuso infine per il ritardo con cui rispondo, ho da poco finito di lavorare.
Di nuovo grazie.
Ciao
se "mastichi" un po' di VBA la macro che ti ho dato, opportunamente modificata, fa quello che chiedi.
Ciao,
Mario
Le venti colonne sono in posizione diverse nei tre fogli come nel file che ho allegato
Quello che vorrei sapere è se non ti importa l'ordine di presentazione delle colonne o se invece (come credo, dall'analisi del tuo esempio) sia un requisito. Perchè allora ok il codice di Supermario ma l'intervallo va opportunamente modificato foglio per foglio e a seconda dell'ordine delle colonne.
Ciao a tutti
non sarei d'accordo su
ma l'intervallo va opportunamente modificato foglio per foglio e a seconda dell'ordine delle colonne.
cn = Application.Match(dato, Sheets(matrice).Range(intervallo), 0)
La riga suddetta cambia ogni volta, per ogni foglio e per ogni riga e per ogni colonna.
Ciao,
Mario
Ok... Allora sono io che non ho capito il problema originale e il risultato atteso perchè sono una testa dura
Credevo che lui avesse delle colonne in ordine sparso e che le volesse riepilogare in un ordine ben preciso, però variabile da foglio a foglio.
Cioè: da foglio 1 prendi le colonne come stanno in sequenza da B a K, da foglio 2 prendi le colonne A B H I C D J E K (e sono anche meno rispetto agli altri fogli) , da foglio 3 invece la sequenza è A K F G B C J D H E I.
Vero anche che OP ha detto che le colonne sono in totale 20 mentre le sequenze che ho indicato io danno un totale di 31 colonne.
Buona sera Forum rieccomi qui con un nuovo file allegato.
Nonostante i chiarimenti, non riuscivo a spiegare la mia reale esigenza perciò ho deciso di trovare soluzioni per partire da una base reale tranne che nel numero delle colonne da copiare.
Senza aver mai avuto approcci con il codice VBA sono riuscito a ottenere il risultato finale che presenta alcuni errori per cui ho cercato risposte in rete senza esito.
A questo punto purtroppo sono praticamente bloccato, per cui propongo i quesiti al Forum:
Modulo4
Il problema più importante nasce dall'esigenza di dover copiare anche tutte le celle vuote, cui secondo me si associa in conseguenza anche quello dell'accodamento.
Modulo 3
Ho problemi con l'importazione del csv che cambia sempre nome, poiché indica sempre la data e l'ora del download come ad esempio test28_01_2019 21-28-18.csv
E' possibile fare con il VBA qualcosa del tipo test*.*.csv come si faceva nel vecchio DOS? Forse è più semplice creare un form dove selezionare il file da importare?
Grazie a tutti.
Allegati:
You must be logged in to view attached files.Buona sera Forum,
ho trovato la soluzione al Modulo 3 è macchinosa ma va bene lo stesso, eccola:
Sub ImportaCSV3()
'Updateby Extendoffice 20150909
Columns("A:AB").EntireColumn.Delete ' cancella i dati nelle colonne
Dim xFileName As Variant
Dim Rg As Range
Dim xAddress As String
xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Kutools for Excel", , False)
If xFileName = False Then Exit Sub
On Error Resume Next
Set Rg = Application.InputBox("Seleziona la cella dove iniziare a importare", "Kutools for Excel", Application.ActiveCell.Address, , , , , 8)
On Error GoTo 0
If Rg Is Nothing Then Exit Sub
xAddress = Rg.AddressSaluti
Buona sera Forum ,
è da tre giorni che tento invano di capire perchè il codice che segue non funziona come vorrei, non copia le celle vuote o si comporta stranamente. Ho provare a cercare altre soluzioni su internet ma tutte le ricerce sono state vane.
Se possibile gli date un'occhiata? Grazie
Sub creareDBRISULTATI() Dim RangeA As Range Dim RangeB As Range Dim RangeC As Range Dim RangeD As Range Dim RangeE As Range Dim RangeF As Range Dim RangeG As Range Dim RangeH As Range Dim RangeI As Range Dim RangeJ As Range Dim RangeK As Range Dim RangeL As Range With Worksheets("FOGLIO1") inizio = 2 Sheets("RISULTATI").Range("A2:Z65536").ClearContents Sheets("RISULTATI").Range("A2:Z65536").ClearFormats Set RangeA = .Range("A1", .Range("A1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("B2:B" & RangeA.Rows.Count).Value = RangeA.Value Set RangeB = .Range("B1", .Range("B1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("C2:C" & RangeB.Rows.Count).Value = RangeB.Value Set RangeC = .Range("C1", .Range("C1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("D2:D" & RangeC.Rows.Count).Value = RangeC.Value Set RangeD = .Range("D1", .Range("D1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("E2:E" & RangeD.Rows.Count).Value = RangeD.Value Set RangeE = .Range("G1", .Range("G1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("F2:F" & RangeE.Rows.Count).Value = RangeE.Value Set RangeF = .Range("J1", .Range("J1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("G2:G" & RangeF.Rows.Count).Value = RangeF.Value Set RangeG = .Range("H1", .Range("H1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("H2:H" & RangeG.Rows.Count).Value = RangeG.Value Set RangeH = .Range("Q1", .Range("Q1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("I2:I" & RangeH.Rows.Count).Value = RangeH.Value Set RangeI = .Range("S1", .Range("S1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("J2:J" & RangeI.Rows.Count).Value = RangeI.Value Set RangeJ = .Range("T1", .Range("T1").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("K2:K" & RangeJ.Rows.Count).Value = RangeJ.Value Set RangeK = .Range("V2", .Range("V2").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("L2:L" & RangeK.Rows.Count).Value = RangeK.Value ' COME COPIARE RANGE VUOTO Set RangeL = .Range("W2", .Range("W2").End(xlDown)).Offset(1) Sheets("RISULTATI").Range("M2:M" & RangeL.Rows.Count).Value = RangeL.Value ' COPIARE RANGE VUOTO End With Fine = Sheets("RISULTATI").Range("B" & Rows.Count).End(xlUp).Row With Worksheets("RISULTATI") .Range("Z" & inizio & ":Z" & Fine).Value = Worksheets("FOGLIO1").Name End With With Worksheets("FOGLIO2") Set RangeA = .Range("B2", .Range("B2").End(xlDown)) RangeA.Copy Sheets("RISULTATI").Range("B" & Rows.Count).End(xlUp).Offset(1) Set RangeB = .Range("D2", .Range("D2").End(xlDown)) RangeB.Copy Sheets("RISULTATI").Range("C" & Rows.Count).End(xlUp).Offset(1) Set RangeC = .Range("E2", .Range("E2").End(xlDown)) RangeC.Copy Sheets("RISULTATI").Range("D" & Rows.Count).End(xlUp).Offset(1) Set RangeD = .Range("F2", .Range("F2").End(xlDown)) RangeD.Copy Sheets("RISULTATI").Range("E" & Rows.Count).End(xlUp).Offset(1) Set RangeE = .Range("M2", .Range("M2").End(xlDown)) RangeE.Copy Sheets("RISULTATI").Range("F" & Rows.Count).End(xlUp).Offset(1) Set RangeF = .Range("L2", .Range("L2").End(xlDown)) RangeF.Copy Sheets("RISULTATI").Range("G" & Rows.Count).End(xlUp).Offset(1) Set RangeG = .Range("K2", .Range("K2").End(xlDown)) RangeG.Copy Sheets("RISULTATI").Range("H" & Rows.Count).End(xlUp).Offset(1) Set RangeH = .Range("H2", .Range("H2").End(xlDown)) RangeH.Copy Sheets("RISULTATI").Range("I" & Rows.Count).End(xlUp).Offset(1) Set RangeI = .Range("Q2", .Range("Q2").End(xlDown)) RangeI.Copy Sheets("RISULTATI").Range("J" & Rows.Count).End(xlUp).Offset(1) Set RangeJ = .Range("G2", .Range("G2").End(xlDown)) RangeJ.Copy Sheets("RISULTATI").Range("K" & Rows.Count).End(xlUp).Offset(1) Set RangeK = .Range("R2", .Range("R2").End(xlDown)) RangeK.Copy Sheets("RISULTATI").Range("M" & Rows.Count).End(xlUp).Offset(1) Set RangeL = .Range("I2", .Range("I2").End(xlDown)) RangeL.Copy Sheets("RISULTATI").Range("L" & Rows.Count).End(xlUp).Offset(1) End With Fine = Sheets("RISULTATI").Range("Z" & Rows.Count).End(xlUp).Offset(-1).Row With Worksheets("RISULTATI") .Range("Z" & inizio & ":Z" & Fine).Value = Worksheets("FOGLIO2").Name ' IL CODICE SOSTITUISCE IL PRECEDENTE NON CONTINUA End With With Worksheets("FOGLIO3") Set RangeA = .Range("E1", .Range("E1").End(xlDown)) RangeA.Copy Sheets("RISULTATI").Range("B" & Rows.Count).End(xlUp).Offset(1) Set RangeB = .Range("J1", .Range("J1").End(xlDown)) RangeB.Copy Sheets("RISULTATI").Range("C" & Rows.Count).End(xlUp).Offset(1) Set RangeC = .Range("B1", .Range("B1").End(xlDown)) RangeC.Copy Sheets("RISULTATI").Range("D" & Rows.Count).End(xlUp).Offset(1) Set RangeD = .Range("D1", .Range("D1").End(xlDown)) RangeD.Copy Sheets("RISULTATI").Range("E" & Rows.Count).End(xlUp).Offset(1) Set RangeE = .Range("H1", .Range("H1").End(xlDown)) RangeE.Copy Sheets("RISULTATI").Range("G" & Rows.Count).End(xlUp).Offset(1) Set RangeF = .Range("O1", .Range("O1").End(xlDown)) RangeF.Copy Sheets("RISULTATI").Range("H" & Rows.Count).End(xlUp).Offset(1) Set RangeG = .Range("L1", .Range("L1").End(xlDown)) RangeG.Copy Sheets("RISULTATI").Range("I" & Rows.Count).End(xlUp).Offset(1) Set RangeH = .Range("C1", .Range("C1").End(xlDown)) RangeH.Copy Sheets("RISULTATI").Range("J" & Rows.Count).End(xlUp).Offset(1) Set RangeI = .Range("L1", .Range("L1").End(xlDown)) RangeI.Copy Sheets("RISULTATI").Range("K" & Rows.Count).End(xlUp).Offset(1) Set RangeJ = .Range("I1", .Range("I1").End(xlDown)) RangeJ.Copy Sheets("RISULTATI").Range("L" & Rows.Count).End(xlUp).Offset(1) Set RangeK = .Range("P1", .Range("P1").End(xlDown)) RangeK.Copy Sheets("RISULTATI").Range("M" & Rows.Count).End(xlUp).Offset(1) Set RangeL = .Range("I2", .Range("I2").End(xlDown)) ' MOLTIPLICARE PER 1000 IL RISULTATO E' POSSIBILE? RangeL.Copy Sheets("RISULTATI").Range("L" & Rows.Count).End(xlUp).Offset(1) End With Fine = Sheets("RISULTATI").Range("Z" & Rows.Count).End(xlUp).Offset(-1).Row With Worksheets("RISULTATI") .Range("Z" & inizio & ":Z" & Fine).Value = Worksheets("FOGLIO3").Name ' IL CODICE SOSTITUISCE IL PRECEDENTE NON CONTINUA End With End Sub
grazie vecchio frac, lo allego
Allegati:
You must be logged in to view attached files.Buona sera Forum, non vorrei sembrare assillante nel proseguire la discussione.
L'assenza di risposte indica che la strada che ho individuato è sbagliata, senza competenze cosa potevo aspettarmi, ci ho provato. Sapreste indicarmi dove cercare qualcosa che fa al caso mio?
Sto googlando nel mondo con termini consolidare, incolonnare, range ecc. ecc. senza nessun risultato.
Grazie
L'assenza di risposte indica che la strada che ho individuato è sbagliata
No, indica solo che mi sono scordato di seguire il thread quindi ti chiedo scusa 🙂
Ogni tanto, lo dico sempre, se vedete che non rispondo più, fatemi un messaggio (privato) di sveglia 😛
Scusami davvero ma mi sono perso a fare altro in questi giorni. Riprenderò quindi in mano la discussione per ritrovare il filo perduto, abbi pazienza (non è che ho il monopolio sia chiaro, tutti possono intervenire 🙂 )
Ho cominciato a darci un'occhiata.
Manca Option Explicit, meglio metterlo e quindi dichiarare as Long anche inizio e fine.
Le due istruzioni:
Sheets("RISULTATI").Range("A2:Z65536").ClearContents Sheets("RISULTATI").Range("A2:Z65536").ClearFormats
si possono unire e ottenere lo stesso effetto con:
Sheets("RISULTATI").Range("A2:Z65536").Clear
Inoltre, qui:
Set RangeA = .Range("A1", .Range("A1").End(xlDown)).Offset(1)
non funzione come ti aspetti, a causa della riga vuota (riga 1). Sostituisci con:
set RangeA = Range("A2", cells(rows.Count, 1).End(xlUp))
Vado avanti a capire il funzionamento 🙂
-
AutoreArticoli