Condividi:        

[EXCEL] Macro complessa per ricerca e compilazione

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

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 17/05/13 14:14

Penso che la soluzione di Flash si meglio per le mie esigenze.

Grazie
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Sponsor
 

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 18/05/13 12:50

Prima di approfondire per un errore che ho (memoria esaurita) vorrei sapere se questo file
va bene come output (sono le prime 400 righe)

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 18/05/13 14:22

I dati sono tutti sfalzati.
Ti faccio un esempio:
La colonna A del file Output_7.csv deve importare i dati dalla colonna C del file cat.csv
Nella cella A2 del file Output_7.csv ci dovrebbe essere il valore della cella C2 del file cat.csv e cioè il valore "M10T0441S" mentre è presente il valore "2 magenta"
Poi molte celle sono vuote.
Nelle colonne "I" e "J" e "K" dovrebbero essere presenti solo devi valori numerici ma vedo presenti anche molto testo.
Ciao
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 20/05/13 11:32

Flash30005 ha scritto:Prima di approfondire per un errore che ho (memoria esaurita) vorrei sapere se questo file
va bene come output (sono le prime 400 righe)

ciao

Hai notato il problema? :roll:
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 20/05/13 23:49

Ok
prova questa macro
ma spero utilizzi excel 207 o superiore perché con 2003 va in errore memoria esaurita
Codice: Seleziona tutto
Sub CreaArch3()
    Dim VArr
Perc = ThisWorkbook.Path & "\"
NomeA = ThisWorkbook.Name
Dim MyFile, MyStr As String
NFoglio = ActiveSheet.Name
Worksheets(NFoglio).Select
If Dir(Perc & "Archivio", vbDirectory) = "" Then
    MkDir (Perc & "Archivio")
End If
Worksheets(NFoglio).Range("A2:IV10000").Clear
MyFile = "Cat.Csv"
Workbooks.Open Filename:=Perc & "cat.csv"
Application.DisplayAlerts = False

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = True
   
    URF = Workbooks(MyFile).Worksheets("Cat").Range("A" & Rows.Count).End(xlUp).Row
   
 For RRF = 2 To URF
VArr = Worksheets("Cat").Range("A" & RRF & ":T" & RRF).Value
    Workbooks(NomeA).Worksheets(NFoglio).Range("A" & RRF).Value = VArr(1, 3)
    Bstr = VArr(1, 4)
    Workbooks(NomeA).Worksheets(NFoglio).Range("B" & RRF).Value = Bstr
    Workbooks(NomeA).Worksheets(NFoglio).Range("C" & RRF).Value = VArr(1, 10)
    Workbooks(NomeA).Worksheets(NFoglio).Range("D" & RRF).Value = Bstr & "-" & VArr(1, 1) & "-" & VArr(1, 3) '<<<< memoria esaurita
    Workbooks(NomeA).Worksheets(NFoglio).Range("E" & RRF).Value = VArr(1, 6)
    Workbooks(NomeA).Worksheets(NFoglio).Range("G" & RRF).Value = VArr(1, 5)
    Workbooks(NomeA).Worksheets(NFoglio).Range("H" & RRF).Value = VArr(1, 1) & "-" & VArr(1, 2)
    Workbooks(NomeA).Worksheets(NFoglio).Range("I" & RRF).Value = Val(VArr(1, 7)) * 1.3
    Workbooks(NomeA).Worksheets(NFoglio).Range("J" & RRF).Value = Val(VArr(1, 7)) * 1.2
    Workbooks(NomeA).Worksheets(NFoglio).Range("K" & RRF).Value = VArr(1, 7)
    Workbooks(NomeA).Worksheets(NFoglio).Range("N" & RRF).Value = VArr(1, 8)
    Workbooks(NomeA).Worksheets(NFoglio).Range("P" & RRF).Value = 1
    Workbooks(NomeA).Worksheets(NFoglio).Range("S" & RRF).Value = VArr(1, 9)
    Workbooks(NomeA).Worksheets(NFoglio).Range("T" & RRF).Value = 7

    Next RRF

Workbooks(MyFile).Close savechanges:=False
    If Len(Dir(Perc & "Archivio\" & MyFile)) > 0 Then Kill Perc & "Archivio\" & MyFile
    'Name Perc & MyFile As Perc & "Archivio\" & MyFile
Worksheets(NFoglio).Select
'    Columns("A:T").EntireColumn.AutoFit
   Range("A1").Select
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 21/05/13 15:49

Di office ho l'ultima versione infatti la macro la fa molto velocemente.
Ma mi da un errore:
"Errore di Run-Time '9':
Indice non incluso nell'intervallo
Se clicco su Debug mi colora in giallo la riga:

Workbooks("output_7.xls").Worksheets(NFoglio).Range("A" & RRF).Value = VArr(1, 3)

La macro la devo applicare al file output_7.csv o su un altro file ?
Grazie
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 21/05/13 18:51

Ho trovato il problema era sbagliata l'estensione nella riga selezionata precedentemente del file output_7.csv anzichè "csv" era "xls".
Ora la procedura va in esecuzione ma non riporta correttamente i dati.
Ti allego il file http://www.ecartucce.it/output_7.csv
Come vedi i dati sono in ordine sparso nelle varie colonne.
Alcune presentano degli spazi vuoti.

Ciao
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 23/05/13 06:12

Prova ad usare questa macro in sostituzione della precedente
Codice: Seleziona tutto
Sub CreaArch3()
    Dim VArr
Perc = ThisWorkbook.Path & "\"
NomeA = ThisWorkbook.Name
Dim MyFile, MyStr As String
NFoglio = ActiveSheet.Name
Worksheets(NFoglio).Select
If Dir(Perc & "Archivio", vbDirectory) = "" Then
    MkDir (Perc & "Archivio")
End If
Worksheets(NFoglio).Range("A2:IV10000").Clear
MyFile = "Cat.Csv"
Workbooks.Open Filename:=Perc & "cat.csv"

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
    ActiveWindow.SmallScroll Down:=-3
   

   
    URF = Workbooks(MyFile).Worksheets("Cat").Range("A" & Rows.Count).End(xlUp).Row
   
 For RRF = 2 To URF
VArr = Worksheets("Cat").Range("A" & RRF & ":T" & RRF).Value
    Workbooks(NomeA).Worksheets(NFoglio).Range("A" & RRF).Value = VArr(1, 3)
    Bstr = VArr(1, 4)
    Workbooks(NomeA).Worksheets(NFoglio).Range("B" & RRF).Value = Bstr
    Workbooks(NomeA).Worksheets(NFoglio).Range("C" & RRF).Value = VArr(1, 10)
    Workbooks(NomeA).Worksheets(NFoglio).Range("D" & RRF).Value = Bstr & "-" & VArr(1, 1) & "-" & VArr(1, 3)
    Workbooks(NomeA).Worksheets(NFoglio).Range("E" & RRF).Value = VArr(1, 6)
    Workbooks(NomeA).Worksheets(NFoglio).Range("G" & RRF).Value = VArr(1, 5)
    Workbooks(NomeA).Worksheets(NFoglio).Range("H" & RRF).Value = VArr(1, 1) & "-" & VArr(1, 2)
    Workbooks(NomeA).Worksheets(NFoglio).Range("I" & RRF).Value = Val(VArr(1, 7)) * 1.3
    Workbooks(NomeA).Worksheets(NFoglio).Range("J" & RRF).Value = Val(VArr(1, 7)) * 1.2
    Workbooks(NomeA).Worksheets(NFoglio).Range("K" & RRF).Value = VArr(1, 7)
    Workbooks(NomeA).Worksheets(NFoglio).Range("N" & RRF).Value = VArr(1, 8)
    Workbooks(NomeA).Worksheets(NFoglio).Range("P" & RRF).Value = 1
    Workbooks(NomeA).Worksheets(NFoglio).Range("S" & RRF).Value = VArr(1, 9)
    Workbooks(NomeA).Worksheets(NFoglio).Range("T" & RRF).Value = 7

    Next RRF

Workbooks(MyFile).Close savechanges:=False
    If Len(Dir(Perc & "Archivio\" & MyFile)) > 0 Then Kill Perc & "Archivio\" & MyFile
    'Name Perc & MyFile As Perc & "Archivio\" & MyFile
Worksheets(NFoglio).Select
'    Columns("A:T").EntireColumn.AutoFit
   Range("A1").Select
End Sub
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 24/05/13 15:17

Ora va molto meglio gran parte delle colonne sono ben compilate.
Ma ci sono ancora alcune colonne che non riportano alcun valore e cioè:

La colonna I del file Output_7.csv deve importare i dati dalla colonna G del file cat.csv aggiungendo a quel valore il 30% e essere formato numero con due cifre decimali
La colonna J del file Output_7.csv deve importare i dati dalla colonna G del file cat.csv aggiungendo a quel valore il 20% e essere formato numero con due cifre decimali
La colonna K del file Output_7.csv deve importare i dati dalla colonna G del file cat.csv


La colonna N del file Output_7.csv deve importare i dati dalla colonna H del file cat.csv


La colonna S del file Output_7.csv deve importare i dati dalla colonna I del file cat.csv

Per il resto la formattazione va bene.
Dovremmo esserci quasi.

Grazie
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 24/05/13 16:07

A me sembra che riporti i valori in I con il 30% in più
e in J il valore con il 20% in più
In K il valore della colonna G (quando esiste)
In N riporta quello che è in H
e in S quello che è in I
per quanto riguarda la formattazione decimale puoi aggiungere a fine macro questo codice
Codice: Seleziona tutto
Columns("I:K").NumberFormat = "0.00"


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 24/05/13 16:21

Ora provo perchè alcune colonne non le ha importate bene.
Avevo impostato il separatore delle migliaglia come . anzichè la ,

Riprovo
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 24/05/13 16:28

Il codice da aggiungere a fine macro è questo
Codice: Seleziona tutto
Columns("I:K").NumberFormat = "0.00"
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 24/05/13 16:30

Ti allego nuovamente il file perchè accade qualcosa al momento dell'apertura del file cat.csv
Sembra che in fase di apertura perda la sua formattazione.
il risultato dell'importazione lo vedi in questo link:
http://www.ecartucce.it/output_7.csv

Grazie
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 24/05/13 16:35

Io, invece, ottengo questo risultato

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 24/05/13 19:54

Ho controllato il tuo file.
Devo dire che il mio risultato è molto più corretto.
Per esempio la colonna N non è compilata perchè dovrebbe contenere solo 1 o 0 mentre ci sono parti di testo pescate qua e la così come la colonna S dovrebbe contenere url immagine ma in molti campi o non è presente alcun dato o sono presenti altri dati.
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Anthony47 » 25/05/13 00:39

Sapete che la soluzione da me preferita e' tramite formule, mi intrometto lo stesso sperando di dare un contributo a questa soluzione macro.
Essendo il file di origine dati un ".csv" e' poco prudente lavorare su di esso con Workbooks.Open; io procederei invece a una "importazione" del suo contenuto, seguita dalla mappatura delle colonne come desiderato da ipsoware, il salvataggio del foglio risultante in formato csv, la chiusura del file senza ulteriori salvataggi.
Pertanto la mia proposta e' di partire da un file "pippo.xlsm" (il nome e' a libera scelta), contenente un unico foglio di nome output_7, contenente solo le intestazioni in riga 1 (tutto il resto SARA' CANCELLATO senza preavviso), e questa macro da copiare in un Modulo standard del vba:
Codice: Seleziona tutto
Sub CreaArch222()
Dim VArr, nFoglio As String
'
Perc = ThisWorkbook.Path & "\"
nFoglio = ActiveSheet.Name
ActiveSheet.Range("A2").Resize(Rows.Count - 1, Columns.Count).Clear
'
Sheets.Add
'
myCsv = Perc & "cat.csv"
   
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myCsv _
    , Destination:=Range("A1"))
    .Name = "cat"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 2)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
'
URF = Range("A" & Rows.Count).End(xlUp).Row
'
VArr = ActiveSheet.Range("A2:T" & URF).Value
For RRF = 1 To URF - 1
    Worksheets(nFoglio).Range("A" & RRF + 1).Value = VArr(RRF, 3)
    Worksheets(nFoglio).Range("B" & RRF + 1).Value = VArr(RRF, 4)
    Worksheets(nFoglio).Range("C" & RRF + 1).Value = VArr(RRF, 10)
    Worksheets(nFoglio).Range("D" & RRF + 1).Value = VArr(RRF, 4) & "-" & VArr(RRF, 1) & "-" & VArr(RRF, 3)
    Worksheets(nFoglio).Range("E" & RRF + 1).Value = VArr(RRF, 6)
    Worksheets(nFoglio).Range("G" & RRF + 1).Value = VArr(RRF, 5)
    Worksheets(nFoglio).Range("H" & RRF + 1).Value = VArr(RRF, 1) & "-" & VArr(RRF, 2)
    Worksheets(nFoglio).Range("I" & RRF + 1).Value = Val(VArr(RRF, 7)) * 1.3
    Worksheets(nFoglio).Range("J" & RRF + 1).Value = Val(VArr(RRF, 7)) * 1.2
    Worksheets(nFoglio).Range("K" & RRF + 1).Value = VArr(RRF, 7)
    Worksheets(nFoglio).Range("N" & RRF + 1).Value = VArr(RRF, 8)
    Worksheets(nFoglio).Range("P" & RRF + 1).Value = 1
    Worksheets(nFoglio).Range("S" & RRF + 1).Value = VArr(RRF, 9)
    Worksheets(nFoglio).Range("T" & RRF + 1).Value = 7
    'Workbooks("output_7.xls").Worksheets(NFoglio).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = A
Next RRF
'
Sheets(nFoglio).Select
ActiveWorkbook.SaveAs Filename:=Perc & "Output_7.csv", _
    FileFormat:=xlCSV, CreateBackup:=False, local:=True
'
Stop

ThisWorkbook.Close savechanges:=False

End Sub
La macro usa il codice sviluppato da Flash, con gli adattamenti per realizzare il processo descritto prima; inoltre ho eliminato la parte che cercava tutti i file csv (nel quesito posto c' e' un solo file, cat.csv).
Il file di uscita e' scritto nella stessa directory dove si trovano il file pippo.xlsm e cat.csv.
Ricordate di salvare il file pippo.xlsm prima di eseguire la macro CreaArch222, perche' la macro modifica il nome e il formato corrente; ho inserito comunque uno Stop prima della chiusura del file per gestire eventuali dimenticanze in fase di preparazione del file, la riga si puo' eliminare quando il debug e' completato.

Spero sia di qualche aiuto.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 26/05/13 19:45

Adesso funziona anche se da due piccoli errori.
Il primo l'ho risolto era l'iniziale del file output_7.csv maiuscolo.
Mentre il secondo da un errore di debug nell'ultime righe nell'istruzione:
'
Stop
Ho provato a togliere l'istruzione "Stop" e il file output_7.csv viene compilato correttamente ma non viene riportata l'intestazione delle colonne.
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Anthony47 » 27/05/13 00:33

Come da istruzioni:
Pertanto la mia proposta e' di partire da un file "pippo.xlsm" (il nome e' a libera scelta), contenente un unico foglio di nome output_7, contenente solo le intestazioni in riga 1


ho inserito comunque uno Stop prima della chiusura del file per gestire eventuali dimenticanze in fase di preparazione del file, la riga si puo' eliminare quando il debug e' completato

Quindi le intestazioni le devi mettere tu nel file "pippo.xlsm", in riga 1 del foglio output_7, e Stop lo puoi rimuovere quando hai completato il debug del file.

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

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi ipsoware » 01/06/13 16:13

Ti ringrazio dell'aiuto la macro funziona perfettamente.
l'unica cosa nell'istruzione:
Workbooks(NomeA).Worksheets(NFoglio).Range("I" & RRF).Value = Val(VArr(1, 7)) * 1.3
Workbooks(NomeA).Worksheets(NFoglio).Range("J" & RRF).Value = Val(VArr(1, 7)) * 1.2

capita che se il valore soggetto al calcolo è inferiore a 1 (per esempio 0,8) non effettua nessun calcolo o lo effettua in maniera errata perchè riporta 0
Da cosa può dipendere?
ipsoware
Utente Junior
 
Post: 40
Iscritto il: 01/05/13 07:25
Località: Viterbo

Re: [EXCEL] Macro complessa per ricerca e compilazione

Postdi Flash30005 » 01/06/13 22:48

Prova a sostituire con queste (suppongo che la virgola renda stringa il dato per questo dà zero)
Codice: Seleziona tutto
Workbooks(NomeA).Worksheets(NFoglio).Range("I" & RRF).Value = Val(Replace(VArr(1, 7), ",", ".")) * 1.3
Workbooks(NomeA).Worksheets(NFoglio).Range("J" & RRF).Value = Val(Replace(VArr(1, 7), ",", ".")) * 1.2


Fai sapere

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL] Macro complessa per ricerca e compilazione":


Chi c’è in linea

Visitano il forum: Nessuno e 38 ospiti