600000 record

Hai un problema con Excel?

Nuova discussione

600.000 record
di Sarasund (utente non iscritto) data: 17/06/2013 22:20:40
Ciao a tutti, sto sviluppando una macro per lavoro.
La macro deve lavorare/gestire circa 620.000 record di un file .txt, nello specifico deve:
-eliminare dei record qualora alcuni dati in specifiche colonne non soddisfano certe condizioni
-confrontare i record restanti con i record in altri fogli attraverso una chiave comune

La macro che ho sviluppato prevede l'importazione del file .txt all'interno di uno sheet ma per ogni ciclo impiega almeno 5/6 minuti (ho creato un ciclo per l'eliminazione dei record non importanti, un ciclo per il confronto con gli altri fogli e un ciclo finale per la creazione di un report)

C'è un modo per ottimizzare/velocizzare il codice?
Pensavo di gestire i dati attraverso delle matrici ma non sono riuscita a trovare la giusta sintassi.

Grazie in anticipo!
di Textomb data: 18/06/2013 00:28:18
ciao Sarasund
credo che sarà difficile darti dei suggerimenti se non ci fai vedere quello che hai scritto.
di Vecchio Frac data: 18/06/2013 11:02:44
Forse Excel non è lo strumento adatto.

di Sarasund (utente non iscritto) data: 18/06/2013 20:25:25
Hai ragione.. allego il codice, ma siate clementi! è la prima macro che scrivo, o meglio è la prima volta che ne scopro l'esistenza! quello che ho imparato l'ho letto dai forum, quindi so che ci sono istruzioni migliori di quelle che conosco, vorrei solo imparare..

Grazie!

Sub Genera_Report()
'

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets("Dashboard").Activate

'controllo i parametri inseriti
If Cells(4, 5) = "" Or Cells(6, 5) = "" Then parametri = MsgBox("E' necessario inserire tutti i parametri al fine di proseguire con l'elaborazione.", vbOKOnly)
If parametri = vbOK Then
Exit Sub
End If

data_estr = Left(Cells(4, 5), 2) & "/" & Mid(Cells(4, 5), 4, 2) & "/" & Right(Cells(4, 5), 4)
datafile = Cells(4, 5)
compagnia = Cells(6, 5)
comp = Right(Cells(6, 5), 3)

Path_output = ThisWorkbook.Path & ("") & "Polizze scadute da liquidare"
Path = ThisWorkbook.Path & ("")
nome = "ARRE_" & comp & "_" & Left(Cells(4, 5), 2) & "_" & Mid(Cells(4, 5), 4, 2) & "_" & Right(Cells(4, 5), 4) & ".txt"
nomesc = "SCADUTE_" & comp & "_" & Left(Cells(4, 5), 2) & "_" & Mid(Cells(4, 5), 4, 2) & "_" & Right(Cells(4, 5), 4) & ".txt"
file = Path_output & nome
filesc = Path_output & nomesc
nome_output = nome & ".xls"
nomesc_output = nomesc & ".xls"

GoTo prova
'controllo che la cartella di destinazione esiste
If Dir(Path_output, vbDirectory) = "" Then
esfile = MsgBox("La cartella di destinazione: Richieste da lavorare non è presente. E' necessario creare in questa cartella di lavoro una sottocartella denominata: Richieste da lavorare e procedere nuovamente con l'esportazione.", vbOKOnly)
End If
If esfile = 1 Then
Exit Sub
Else
End If

'controllo che i due file txt siano già stati importati in precedenti elaborazioni
trovato_foglio = 0
For Each Worksheet In Worksheets
    If Worksheet.Name = "Dati_elaborazione_scadute" Then trovato_foglio = 1
Next Worksheet

If trovato_foglio = 1 Then scelta = MsgBox("I Dati in input relativi ad Arretrato sono già stati importati nel Foglio: Dati_elaborazione_scaduti. Se si intende importarli nuovamente premere Annulla e successivamente pulire il file dal Dashboard, per proseguire premere OK.", vbOKCancel)
If scelta = 2 Then
Exit Sub
Else: If scelta = 1 Then GoTo altro Else
End If

altro:
trovato_foglio = 0
For Each Worksheet In Worksheets
    If Worksheet.Name = "Dati_elaborazione_arretrato" Then trovato_foglio = 1
Next Worksheet

If trovato_foglio = 1 Then scelta = MsgBox("I Dati in input relativi a Scadute sono già stati importati nel Foglio: Dati_elaborazione_arretrato. Se si intende importarli nuovamente premere Annulla e successivamente pulire il file dal Dashboard, per proseguire premere OK.", vbOKCancel)
If scelta = 2 Then
Exit Sub
Else: If scelta = 1 Then GoTo salta Else
End If

'controllo che i file esistono
If Dir(Path & nome) <> "" Then GoTo controlla
esfile = MsgBox("I dati in input inseriti non corrispondono al nome del file da importare. Il nome del file è così composto: ARRE_codice compagnia_gg_mm_aaaa.txt.", vbOKOnly)
If esfile = 1 Then
Exit Sub
Else

End If

controlla:
If Dir(Path & nomesc) <> "" Then GoTo esporta
esfile = MsgBox("I dati in input inseriti non corrispondono al nome del file da importare. Il nome del file è così composto: SCADUTE_codice compagnia_gg_mm_aaaa.txt.", vbOKOnly)
If esfile = 1 Then
Exit Sub
Else

End If

'######################################################################################################################################
'importazione del file ARRE txt su xls
esporta:

    Workbooks.OpenText Filename:= _
        Path & nome _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlNone, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma _
        :=False, Space:=False, Other:=True, OtherChar:="$", 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), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, _
        1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
        27, 1), Array(28, 1)), TrailingMinusNumbers:=True


    ActiveWorkbook.SaveAs Filename:= _
        Path & nome_output _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
  ActiveSheet.Name = "Dati_elaborazione_arretrato"

'copio lo sheet nel file di lavoro

    Sheets("Dati_elaborazione_arretrato").Select
    Sheets("Dati_elaborazione_arretrato").Copy After:=Workbooks( _
        "Macro_polizze_scadute.xlsm").Sheets(3)
'        Windows("Macro_polizze_scadute.xlsm").Activate
    Sheets("Dati_elaborazione_arretrato").Activate


'chiudo e elimino xls di importazione
Workbooks(nome_output).Activate
ActiveWorkbook.Close SaveChanges:=False
Kill Path & nome_output

'######################################################################################################################################
'importazione del file SCADUTE txt su xls

        Workbooks.OpenText Filename:= _
        Path & nomesc _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma _
        :=False, Space:=False, Other:=True, OtherChar:=";", 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), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, _
        1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
        27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), _
        Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array( _
        40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), _
        Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array( _
        53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), _
        Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array( _
        66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array(72, 1), _
        Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), Array( _
        79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array(85, 1), _
        Array(86, 1)), TrailingMinusNumbers:=True

'######################################################################################################################################
'Formatto il file importato

'elimino gli spazi dalle colonne CONCLUSA,CONV.,MADRE, COD.TARIFFA

Columns("AN").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("AK").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("AS").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("AG").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


'cancello i valori nei record con:
'valore = C nella colonna CONCLUSA
'valore = 110 o 99 nella colonna CONV.
'valore <> a 0 nella colonna MADRE

ActiveSheet.Name = "SCADUTE"

i = 2
Do While Cells(i, 2) <> ""
    If Cells(i, 40) = "C" Or Cells(i, 37) = "110" Or Cells(i, 37) = "99" Or Cells(i, 45) <> "0" Then
    Range(Cells(i, 2), Cells(i, 85)).Select
    Selection.ClearContents
    End If
i = i + 1
Loop

'inserisco nuove colonne
Cells(1, 86) = "DESCR. CATEGORIA"
Cells(1, 87) = "AMBITO"
Cells(1, 88) = "PRESCRIZIONE"
Cells(1, 89) = "ANNI"

'copio lo sheet nel file di lavoro
Sheets("SCADUTE").Select
Sheets("SCADUTE").Copy After:=Workbooks( _
   "Macro_polizze_scadute.xlsm").Sheets(4)
   Sheets("SCADUTE").Activate

ActiveSheet.Name = "Dati_elaborazione_scadute"
ActiveWindow.DisplayGridlines = False

'chiudo xls
'Workbooks(nomesc_output).Activate
'ActiveWorkbook.Close SaveChanges:=False

'ThisWorkbook.Activate
Sheets("Dati_elaborazione_scadute").Activate

'Cerco COD.TARIFFA
j = 33
a = 2

Do While Cells(a, 1) <> ""
    If Cells(a, 2) = "" Then GoTo norecord
    valore = Cells(a, j)
    categ = 0
    
        Sheets("Parametri_cod_tariffa").Activate
        x = 3
        Do While Cells(x, 4) <> ""
            If Cells(x, 4) = valore Then
            categ = Cells(x, 19)
            
            Sheets("Parametri_categoria").Activate
            y = 3
            Do While Cells(y, 2) <> categ
            y = y + 1
            Loop
            
                Range(Cells(y, 3), Cells(y, 6)).Select
                Selection.Copy
                Sheets("Dati_elaborazione_scadute").Activate
                Cells(a, 86).PasteSpecial
            
            End If
         x = x + 1
         Loop
norecord:
a = a + 1
Loop
             
'elimino colonne che non servono
    Columns("M:W").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Q:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("U:Y").Select
    Selection.Delete Shift:=xlToLeft
    Columns("V:AC").Select
    Selection.Delete Shift:=xlToLeft
    Columns("W:X").Select
    Selection.Delete Shift:=xlToLeft
    Columns("X:X").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AB:AD").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AC:AE").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AD:AQ").Select
    Selection.Delete Shift:=xlToLeft
    
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    
    Sheets("Parametri_cod_tariffa").Activate
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    
    Sheets("Parametri_categoria").Activate
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    
salta:
'faccio il confronto tra i file con il codice Polizza
prova:

Sheets("Dati_elaborazione_scadute").Activate

i = 2
a = 2

Do While Cells(i, 1) <> ""
    If Cells(i, 2) = "" Then GoTo nienterecord
    valore = Cells(i, 2)
        
        Sheets("Dati_elaborazione_arretrato").Activate
        a = 2
        Do While Cells(a, 1) <> ""
            If Cells(a, 2) = valore Then
            Sheets("Dati_elaborazione_scadute").Activate
            Range(Cells(a, 2), Cells(a, 33)).Select
            Selection.ClearContents
            End If
        a = a + 1
        Loop
        
Sheets("Dati_elaborazione_scadute").Activate

nienterecord:
i = i + 1
Loop

Sheets("Scadute_non_liquidate").Activate
If Cells(3, 2) = "" Then esito = MsgBox("Non sono presenti polizze scadute non liquidate che devono essere lavorate.", vbOKOnly)
If esito = 1 Then
Sheets("Dashboard").Activate
Cells(2, 3).Select
Exit Sub
End If

Vuoi Approfondire?