› Sviluppare funzionalita su Microsoft Office con VBA › Copiare da differenti cartelle righe con un criterio
-
AutoreArticoli
-
Salve a tutti!
Sono nuovo del sito, avrei bisogno di un aiutino.
Ho scritto questo macro (copiando qua è la), però vorrei che al posto di copiarmi tutte le celle (E1:K1100) copiasse solo la riga dove il valore della colonna K è maggiore di 0.
Ho testato la macro funziona, ma riesce a copiare sono 10 file (ogni file ha 1100 celle), avrei la necessità di far copiare solo celle dove ci sono valori maggiori di 0 cosi spero che riesca a lavorare anche 30 file.
Ultima richiesta: all'inizio del codice, richiedo di selezionare i file sul pc, però nella finestra mi appare il nome della cartella e non i file presenti in essa. Dove ho sbagliato?
Come posso scriverlo?
Vi inserisco il codice:
Sub SommaFile()
'Inibisco visualizzazione aggiornamento schermo
Application.ScreenUpdating = False
Application.EnableEvents = False'Assegno il nome del file ad un variabile
'che utilizzerò per richiamare la finestra del file
'dopo aver aperto i singoli file da copiare
FileTotale = ThisWorkbook.Name'Cancello il contenuto del foglio "Archivio Report"
Foglio12.Select
Cells.Select
Selection.Delete Shift:=xlUp'Apro la finestra di dialogo per selezionare la cartella
'dove sono archiviati i report
Dim fDialog As Office.FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Dim selezione As Variant'Definisco il persorso standard da far apparire nella finestra di dialogo
'in questo caso apro la cartella dove è contenuto il file di riepilogo
'Si può modificare in questo modo:
'PercorsoScontrini = "C:\Mia Cartella\"
Dim PercorsoRepository As String
PercorsoScontrini = ThisWorkbook.PathWith fDialog
.AllowMultiSelect = False
.Title = "Seleziona il percorso dove sono salvati i files"
.InitialFileName = PercorsoScontriniIf .Show = -1 Then
For Each selezione In .SelectedItemscartella = selezione 'questa è la cartella selezionata
Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(cartella)
Set sf = f.FilesNumeroFile = 0 'inizializzo la variabile che conta il numero dei report analizzati
For Each f1 In sf 'Per tutti i file nella cartella selezionata
NumeroFile = NumeroFile + 1 'ad ogni report analizzato incremento la variabile di 1
'Seleziono il file dove copiare i report
Sheets("Archivio Report").SelectLast_Row = 0
On Error Resume Next 'questa istruzione eviata l'errore quando si apre il primo report
'identifico l'ultima riga non vuota
Last_Row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Identifico la riga da dove iniziare a copiare i report
Start = Start + Last_Row + 1'Apro il report
ActiveWorkbook.FollowHyperlink Address:=f1.Path
'Seleziono lo sheet1
Sheets("ORDINE").Select'Seleziono i dati da copiare
Range("E1:K1100").Select
'Copio i dati
Selection.Copy
'Attivo la finestra del file "Totale"
Windows(FileTotale).Activate
'Seleziono il foglio "Archivio Report"
Foglio12.Select
'Mi posiziono sulla cella da dove inizio ad incollare i dati
Cells(Start, 1).Select
'incollo i dati
ActiveSheet.Paste
Application.CutCopyMode = False 'pulisco Clipboard evitando di far apparire la finestra di dialogo'identifico l'ultima riga non vuota dopo aver incollato i dati
Last_Row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row'dalla riga in cui ho inziato ad incollare i dati, alla nuova ultima riga
'inserisco il nome del report nella colonna 8
For Z = Start + 1 To Last_Row
Cells(Z, 8) = f1.Name
Next Z'Chiudo la finestra del Report analizzato
Windows(f1.Name).Close'Analizzo il Report successivo
NextNext
Else
'Quando nella finestra di dialogo non seleziono nessuna cartella contenente i report
'faccio apparire messaggio di avvviso
MsgBox "Operazione annullata!", vbInformation
Foglio1.Select
Exit Sub
End If
End WithSet fDialog = Nothing
'Normalizzo il foglio "Archivio Report"
Foglio12.Select
'Seleziono ultima riga non vuota
Last_Row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row'Inserisco l'intestazione della colonna dove ho inserito il nome del report
Range("H1") = "FILE"
Range("H1").Font.Bold = True'Tolgo il merge delle celle A1 e B1
Range("A1:B1").Select
Selection.UnMerge'Imposto la larghezza delle colonne
Columns("A:A").ColumnWidth = 25
Columns("B:B").ColumnWidth = 10
Columns("C:C").ColumnWidth = 10
Columns("D:D").ColumnWidth = 10
Columns("E:E").ColumnWidth = 10
Columns("F:F").ColumnWidth = 10
Columns("G:G").ColumnWidth = 10
Columns("H:H").ColumnWidth = 36'Blocco la prima riga
Rows("2:2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With'Metto il filtro
ActiveWindow.FreezePanes = True
Range("A1:H1").Select
Selection.AutoFilter'Seleziono lo sheet "GENERALE"
Foglio1.Select'Dalla riga 6 alla 1100 inserisco i totali
For i = 6 To 1100Foglio1.Cells(i, 8) = Application.WorksheetFunction.SumIf(Foglio12.Columns(1), Foglio1.Cells(i, 3), Foglio12.Columns(6))
Next i
'Inserisco il numeor dei file analizzati
Foglio7.Select
Range("K2") = NumeroFile
Range("K2").Font.Bold = True
Range("B2").Select'Riabilito visualizzazione aggiornamento schermo
Application.ScreenUpdating = True
Application.EnableEvents = TrueEnd Sub
Ciao e benvenuto,
1) un file di esempio sarebbe gradito, per non doversi ricostruire uno scenario quasi impossibile da replicare in assenza di indicazioni;
2) il codice si inserisce cliccando il pulsante {;} nell'editor del messaggio che stai scrivendo;
3) quando tu digiti la prima parentesi tonda in
Application.FileDialog(msoFileDialogFolderPicker)
non ti compare forse un elenco di scelte tra cui impostare quella desiderata? tra le quattro voci che appaiono non c'è anche quella per la scelta dei file? tu hai chiesto infatti di aprire la finestra di dialogo che permette di scegliere un folder, cioè una cartella. Scegli quindi la voce appropriata.Ho guardato il codice a volo d'uccello, grosso modo mi sembra che faccia il suo dovere (per testarlo servirebbe qualche dato di esempio, un piccolo file senza dati riservati), anche se qualche parte la scriverei in modo diverso (ma vabbè è questione di stile personale).
Non è che ti copia solo dieci file perchè magari superi il numero di righe contenuto nel foglio? la butto lì anche se è strano perchè ogni file ha 1100 celle, per cui abbondantemente sotto le 65mila righe di Excel 2003 e il milione e rotti di Excel superiori.
E, tanto per buttare un suggerimento, invece che copiare semplicemente da E1 a K1100, potresti attivare un filtro automatico, filtrare sulla colonna K per valori maggiori di zero, copiare le celle visibili e incollarle nel foglio destinazione, quindi chiudere senza salvare e passare al file successivo; tutto via codice naturalmente.
Grazie per i preziosi consigli!!!
La soluzione di copiare solo le celle che hanno un valore
Ho provato a scrivere un codice ma non funziona.
Ho inserito il seguente codice dopo ' seleziono le celle da copiare:
ActiveSheet.Unprotect
Range("E1:K1").Select
Selection.AutoFilter
ActiveSheet.Range("$E$1:$K$1063").AutoFilter Field:=6, Criteria1:=">0,001" _
, Operator:=xlAnd
Range("E1:K884").Select
Selection.Copy
Windows("Copia di Catalogo x ufficio 2.9.xlsm").Activate
Sheets("Archivio Report").Select
Range("A1").Select
ActiveSheet.Paste
Selection.Copy
Windows("Copia di Catalogo x ufficio 2.9.xlsm").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$H$545784").AutoFilter Field:=6
End Sub
Purtroppo non funziona......
Aiuto!!!!!
Una volta applicato l'autofilter, non puoi semplicemente selezionare il range di celle, devi selezionare solo le celle visibili: qualcosa tipo
range.specialcells(xlCellTypeVisible).copy
(chiaramente da adattare e provare al caso di specie)
grazie per i preziosi suggerimenti.
Non riesco ad uscirne..
Allego i file.
Nella cartella test ci sono i file dai quali recuperare i dati, per inserirli nel file copia catalogo per ufficio.
Nelle cartelle 1, il foglio "ordine" dal quale estrarre i dati è protetto, la macro riesce a lavorare comunque?
Grazie per il supporto!
Allegati:
You must be logged in to view attached files.bertu81 wrote:Nelle cartelle 1, il foglio "ordine" dal quale estrarre i dati è protetto
Non mi risulta che sia così, i fogli ordine risultano tutti sbloccati. Comunque non è un problema perchè se non ho capito male tu devi solo operare una lettura dei dati per riversarli in un riepilogo, e non devi scrivere in questi file di dettaglio.
Il quesito è diventato interessante e spero di ritagliarmi una mezz'ora stasera tra una cosa e l'altra 🙂
Scusa una domanda, tu devi copiare dal foglio "ORDINE" di ogni file singolo nel foglio "Archivio Report" del file principale che contiene le macro, tutte le righe in "Ordine" in cui il campo "quantità" ha un valore diverso da zero o vuoto, correct?
Ti faccio un regalino serale, un codice funzionante (almeno sui file che ci hai dato da provare) e che fa tutto quello che avevi ideato tu, solo che lo fa in modo diverso, senza filtri e senza aprire i file da cui copiare. Uso una connessione ADO che legge i file anche se sono chiusi, recupera i dati con una semplice query e infine genera un recordset che viene incollato nella destinazione.
Il codice è in sè piuttosto carino anche da studiarselo.
Al posto dell'oggetto FileDialog utilizzo una BrowseForFolder un po' diversa che a me piace molto (ha una piccola limitazione ma è superabile). Il codice si potrebbe ottimizzare se si fosse certi che tutti i file da leggere (da cui recuperare i dati) hanno tutti e sempre un nome che comincia nello stesso modo (ad esempio, CLASSE, come mi pare di aver capito a cosa ti serve tutto questo leggendo le istruzioni dei fogli).
Poichè il tuo codice va avanti e fa anche altro alla fine, è da completare ma te lo lascio per tuo diletto. Vedi se ci riesci da solo altrimenti ti aiutiamo volentieri 🙂
Tutto il codice va incollato in un modulo (e magari già che ci sei ripulisci o elimina i moduli che non servono... ho visto cose abbastanza nefande nel tuo file :D) (...naturalmente a.i.v.)
Option Explicit Private cn As Object Private rs As Object Sub filter_quantity() Dim fso As Object Dim oFile As Object Dim p As Object Dim s As String Dim iRow As Long Dim aborted As Boolean Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Provider = "MSDASQL" Application.ScreenUpdating = False Sheets("Archivio Report").Select Range("A2:Z50000").ClearContents Set p = BrowseForFolder("Seleziona il percorso dove sono salvati i files:") 'si può specificare un percorso iniziale ma si è vincolati a restare in questo path 'e non si può navigare tra le cartelle, quindi attenzione all'uso: 'Set p = BrowseForFolder("Seleziona il percorso dove sono salvati i files:", ThisWorkbook.Path) If p Is Nothing Then MsgBox "Procedura annullata.", vbInformation aborted = True Else Set fso = CreateObject("Scripting.FileSystemObject") For Each oFile In fso.GetFolder(p.Self.Path).Files If oFile.Name <> ThisWorkbook.Name And Left(oFile.Name, 1) <> "~" Then s = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=%1; ReadOnly=False;" s = Replace(s, "%1", p.Self.Path) cn.ConnectionString = s cn.Open Set rs = cn.Execute("SELECT * FROM [Ordine$E1:K10000] WHERE [quantità]>0") iRow = [MAX(MIN(COUNTA(A:A), 2), COUNTA(A:A))] + 1 Cells(iRow, "A").CopyFromRecordset rs rs.Close cn.Close End If Next End If Application.ScreenUpdating = True Set rs = Nothing Set rs = Nothing Set oFile = Nothing Set fso = Nothing Set p = Nothing If aborted Then Exit Sub MsgBox "Fatto.", vbInformation End Sub Public Function BrowseForFolder(ByVal sPrompt As String, Optional ByVal start_path As Variant = "") As Object 'alternative browseforfolder! 'Usage: 'Set s = BrowseForFolder("Seleziona la cartella:", "C:\defaultdir\") 's contiene solo il nome della cartella selezionata 's.Self.Path contiene il percorso completo della cartella selezionata Dim oShell As Object, oFolder As Object ' StartPath A drive/folder path or one of the following numeric constants: ' DESKTOP = 0, PROGRAMS = 2, DRIVES = 17, NETWORK = 18, ' NETHOOD = 19, PROGRAMFILES = 38, PROGRAMFILESx86 = 48, Windows = 36 'se non è stato specificato un percorso iniziale, parte dal desktop If start_path = "" Then start_path = 0 Set oShell = CreateObject("shell.application") Set oFolder = oShell.BrowseForFolder(0&, sPrompt, 0&, start_path) If (Not oFolder Is Nothing) Then Set BrowseForFolder = oFolder End If Set oFolder = Nothing Set oShell = Nothing End Function
Grazie per l’interessamento!!!
corretto! Devo copiare le righe dei prodotti del foglio ordini dove c’e una quantità superiore a 0.
poi la Macro somma i valori degli stessi articoli e li riporta nel foglio generale.
bertu81 wrote:poi la Macro somma i valori degli stessi articoli e li riporta nel foglio generale
Ecco... questa parte non l'ho programmata 😀 firulì firulà
però puoi provarci da solo, su, ho fiducia in te 😀
GRAZIE!!! per il prezioso aiuto... ho provato a copiare il codice...
Dopo aver scelto il percorso, mi appare l'errore che ti allego.
ancora grazie
Allegati:
You must be logged in to view attached files.Già già, appena ho visto l'errore ho capito. in efftti sono stato frettoloso nel trascrivere il codice.
Ecco la correzione:
s = Replace(s, "%1", oFile.Path)
Siamo dentro l'If che controlla il nome del file (che non sia temporaneo e che non coincida con quello in esecuzione). E' ovvio che la stringa di connessione ADO deve puntare al file Excel corrente per leggervi i dati , non al semplice percorso scelto) 😀
Scusami.
Bene!!
Fai sapere.
sto facendo un po di prove.. con scarsi risultati...
Ho provato a modificare il vecchio codice con la funzione somma se ... ma con pessimi risultati.
non mi riconosce il valore i
Cosa posso fare?
Nel foglio Archivio Report, nella colonna H avrei bisogno che venga indicato il nome del file dal quale si copia la riga.
Grazie!!!
Avrei bisogno per cortesia di sapere esattamente questa seconda parte che cosa deve fare (cioè dopo aver estratto tutti i dati dai vari file e incolonnati nel foglio Archivio Report, che operazioni successive occorre fare?)
Più sei dettagliato e meglio è. Magari puoi allegare un file di esempio col risultato atteso o finale.
Dopo l'operazione di estrazione dei dati avrei bisogno di :
- foglio Archivio Report, nella colonna H avrei bisogno che venga indicato il nome del file dal quale si copia la riga.
- Inserire nella cella K2 il numero di file caricati
-Nel file generale riportare le somme dei singoli prodotti
la formula che mi verrebbe in mente =SOMMA.SE('Archivio Report'!A1:F16;GENERALE!C6;'Archivio Report'!F2:F16); vorrei riportarli sull'elenco generale in tal modo ho già gli articoli divisi per fornitore
-Nel foglio Generale, nella colonna note, riportare le note dei vari prodotti, sulla stessa riga, ho provato con la formula concatena ma con pochi risultati....
Grazie
Ho letto sul che è possibile fare donazioni con il tasto paypal: dove trovo il link?bertu81 wrote:Ho letto sul che è possibile fare donazioni con il tasto paypal: dove trovo il link?
Ho letto le istruzioni ma purtroppo adesso non posso impegnarmi con questa pratica, abbi un pochino di pazienza.
Sulle donazioni, al momento sono disattivate, ma appena avrò informazioni più precise farò la dovuta informazione. Come noto la gestione è cambiata da qualche mese e la nuova amministrazione sta valutando le iniziative per fornire un servizio sempre migliore. Grazie comunque per il pensiero che hai avuto.
grazie per la disponibilità!!
Non c'e nessuna fretta, l'aiuto che mi hai già fornito è molto!!!!!Facciamo così, ti allego il file sul quale ho fatto le prove così partiamo da qui.
Ho riportato il nome del file da cui si pescano i dati nella colonna H dell'archivio e ho inserito in K2 il numero dei file letti.
Adesso però trovo difficile capire cosa sono "le somme dei singoli prodotti" anche perchè nel foglio generale ci sono più prodotti rispetto a quelli caricati. Anche il discorso delle note mi lascia dei dubbi.
Puoi caricare un file finale, cioè col risultato atteso, partendo dai dati inseriti?
Allegati:
You must be logged in to view attached files.Grazie!!!!!!!
Per le note: Perfetto, quello che intendevo. (nel file di prova avevo inserito parole a caso.... però il risultato è quello che mi aspettavo).
Per la somma dei singoli prodotti: ti allego il file con la funzione somma se nella colonna H del foglio generale. Vorrei farla svolgere dalla macro, avevo fatto una prova in passato; caricando nuovi file e cancellando il contenuto del foglio Archivio Report la formula andava in errore.
Es: vicino ad Aglio = Totale quantità di aglio del foglio Archivio report.
Grazie!!!
Allegati:
You must be logged in to view attached files.Ciao!
Un dubbio: noto che il file è diventato molto lento, ogni volta che lavoro sul foglio Archivio, appare in basso a destra sulla barra processo in corso.
Potrebbe essere la macro per unire che rallentata il tutto? posso attivarla solo quando premo il bottone?
Grazie!!
Ok, ancora un piccolo chiarimento, nel foglio archivio report ci sono meno voci rispetto al foglio generale. La macro si limita a registrare le quantità derivanti dalla somma della colonna H di archivio report in corrispondenza della voce relativa nel foglio generale, solo per le voci che trova. Giusto?
Per le note, posso eliminare la funzione "concatenanote" e far fare tutto alla macro? la lentezza del foglio dipende anche da questo. Le funzioni personalizzate vengono eseguite ad ogni ricalcolo 🙂
-
AutoreArticoli