[EXCEL] Caricamento dati da files con accodamento

[fcudia]

Come ti dicevo nel precedente post,

Grazie Flash, tutto a posto, con questa versione non c'è più l'inconveniente dell'errata numerazione

l'ultima modifica da te postata funziona bene, farò qualche test sul campo e ti faccio sapere, ma dalle prove già fatte sembra tutto a posto.

Per il resto ho qualche idea, la razionalizzo e ti faccio sapere.

Grazie.

fabrizio

[Flash30005]

Per il resto ho qualche idea, la razionalizzo e ti faccio sapere

Ok, attendo tue notizie

ciao

[fcudia]

Flash,
Scusa se non ti ho dato notizie prima, ma siamo in periodo di ferie e manca il tempo per tutto, bisogna chiudere tutte le scadenze, mancano persone ecc. per cui non ho avuto tempo di sviluppare le idee che avevo relative all'eliminazione automatica di record già importati. La macro cmq già funziona e vedrò appena ho un pò di tempo di vedere come si può evolvere.
In questi giorni, nei ritagli di tempo, ho modificato il tuo codice, creando un output un pò diverso, ti riassumo le modifiche:
1) i nomi dei file adesso contengono in coda anche il mese di riferimento dell'E.C. (es. MPS_11223344 Marzo 2009.xls)
2) la colonna A del foglio di output adesso contiene infatti il mese dell'estratto conto, e tutti gli altri campi vengono splittati una colona avanti;
3) nella colonna H del foglio di Output adesso estraggo anche la causale dalla descrizione dell'E.C. degli E.C. di MPS, che era contenuta tra parentesi all'inizio della descrizione (se però questa casuale fosse di + di 2 caratteri, non saprei coma fare, InStrRev non legge le parentesi);
Grazie per la chiarezza del tuo codice e per i riferimenti che mi hanno consentito, da neofita, le modifiche.
Ti posto il codice modificato per dargli un occhiata, dai test fatti sembra funzionare bene come prima con lo split delle colonne.

Codice: Seleziona tutto

Ci sentiamo su un altro post per altri argomenti.
Ciao

Fabrizio
Public Perc As String

Sub Riepilogo()
Application.ScreenUpdating = False   '<<< Disattiva la visualizzazione delle operazioni
Application.Calculation = xlManual   '<<< setta in manuale il ricalcolo
ChDrive "F"                          '<<< Imposta il Drive della Path (C, F o altro)
Perc = "F:\Fenice\Banche\Importa_CC\Test su server fenice\Banche\EC Import\"  'Path dove trovare il file degli E.C.
Call ElencoFileXls
If Dir(Perc & "ArchivioXls", vbDirectory) = "" Then
    MkDir (Perc & "ArchivioXls")
End If
URE = Worksheets("Dati").Range("IV" & Rows.Count).End(xlUp).Row
For D = 1 To URE
contatore = 0  '<<<< inserito v.2.0 28/07/2009 23.05
FXLS = Worksheets("Dati").Range("IV" & D).Value
If FXLS = "" Then Exit For
Workbooks.Open Filename:=Perc & FXLS
FX = "Foglio1"
If Mid(FXLS, 1, 3) = "BDS" Then FX = "Movimenti"
URD = Worksheets(FX).Range("A" & Rows.Count).End(xlUp).Row
Workbooks("Importa CC v.2.1.xls").Activate
'Scrive i record dell'E.C. nel file di Output
For RX = 1 To URD
contatore = contatore + 1  '<<<< inserito v.2.0 28/07/2009 23.05
UROut = Worksheets("Output").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Output").Range("A" & UROut).Value = Mid(FXLS, InStr(FXLS, " ") + 1, InStr(FXLS, ".") - InStr(FXLS, " ") - 1) 'Scrive mese anno E.C:
Worksheets("Output").Range("B" & UROut).Value = Mid(FXLS, 1, 3) 'Scrive Banca
Worksheets("Output").Range("C" & UROut).Value = Mid(FXLS, InStrRev(FXLS, "_") + 1, InStr(FXLS, " ") - InStrRev(FXLS, "_") - 1) 'Scrive nr. CC
Worksheets("Output").Range("D" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("A" & RX).Value
Worksheets("Output").Range("E" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("B" & RX).Value
If Mid(FXLS, 1, 3) = "BDS" Then
Worksheets("Output").Range("F" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("C" & RX).Value
Worksheets("Output").Range("G" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("D" & RX).Value
Worksheets("Output").Range("H" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("E" & RX).Value
Else
Desc_MPS = Workbooks(FXLS).Worksheets(FX).Range("D" & RX).Value & " + " & Workbooks(FXLS).Worksheets(FX).Range("E" & RX).Value
Worksheets("Output").Range("F" & UROut).Value = Desc_MPS
Worksheets("Output").Range("G" & UROut).Value = Workbooks(FXLS).Worksheets(FX).Range("C" & RX).Value
Worksheets("Output").Range("H" & UROut).Value = Mid(Desc_MPS, 2, 2) ' Estrae la causale (2 car. se sono 3 c'è problema)
End If
Worksheets("Output").Range("I" & UROut).Value = contatore  '<<<< inserito v.2.0 28/07/2009 23.05
Next RX
Workbooks(FXLS).Close savechanges:=False
DataF = Mid(Date, 7, 4) & Mid(Date, 4, 2) & Mid(Date, 1, 2) & "_" & Mid(Time, 1, 8) '& Mid(Time, 3, 2) 'Data dell'Import
Name Perc & FXLS As Perc & "ArchivioXls\" & DataF & "_" & FXLS
Next D
Call Eliminadoppi
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub ElencoFileXls()   'Scrive i nomi dei file presenti nell Dir di importaione a partire dalla cella IV1
Worksheets("Dati").Select
Range("IV1").Select
  With ActiveCell
    Worksheets("Dati").Range(.Cells(1), .End(xlDown)).ClearContents
  End With
  ElencoFile Direct:=Perc, Estens:="???_*.xls", Inicell:=ActiveCell
End Sub
Sub ElencoFile(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, F As String
  ChDir Direct
  F = Dir(Estens)
  If F = "" Then Exit Sub
  While F <> ""
    i = i + 1
    Inicell(i) = F
    F = Dir
  Wend
End Sub
Sub Eliminadoppi() 'NUOVA macro Elimina doppi v.2.0
Worksheets("Output").Select
URE = Range("B" & Rows.Count).End(xlUp).Row
For EL = 2 To URE - 1
Stringa1 = Range("B" & EL).Value & Range("C" & EL).Value & Range("D" & EL).Value & Range("E" & EL).Value & Range("F" & EL).Value & Range("G" & EL).Value & Range("H" & EL).Value & Range("I" & EL).Value
If Stringa1 = "" Then GoTo esci
For REL = URE To EL + 1 Step -1
Stringa2 = Range("B" & REL).Value & Range("C" & REL).Value & Range("D" & REL).Value & Range("E" & REL).Value & Range("F" & REL).Value & Range("G" & REL).Value & Range("H" & REL).Value & Range("I" & REL).Value
If Stringa1 = Stringa2 Then Rows(REL & ":" & REL).Delete Shift:=xlUp
Next REL
Next EL
esci:
Call ControllaDuplicati
End Sub
Sub ControllaDuplicati()
ContaD = 0
URE = Range("B" & Rows.Count).End(xlUp).Row  'Modificato, non usa per il confronto il mese dell'E.C.
Range("J2:J" & URE).ClearContents
For EL = 2 To URE - 1
Stringa1 = Range("B" & EL).Value & Range("B" & EL).Value & Range("C" & EL).Value & Range("D" & EL).Value & Range("E" & EL).Value & Range("F" & EL).Value & Range("G" & EL).Value & Range("H" & EL).Value  'Modifica alla riga precedente, non usa per il confronto il mese dell'E.C.
If Stringa1 = "" Then GoTo esci
For REL = URE To EL + 1 Step -1
Stringa2 = Range("B" & REL).Value & Range("B" & REL).Value & Range("C" & REL).Value & Range("D" & REL).Value & Range("E" & REL).Value & Range("F" & REL).Value & Range("G" & REL).Value & Range("H" & REL).Value  'Modifica alla riga precedente, non usa per il confronto il mese dell'E.C.
If Stringa1 = Stringa2 Then
If Worksheets("Output").Range("J" & EL).Value = "" Then
ContaD = ContaD + 1
Worksheets("Output").Range("J" & EL).Value = ContaD
End If
Worksheets("Output").Range("J" & REL).Value = Worksheets("Output").Range("J" & EL).Value
End If
Next REL
Next EL
esci:
If ContaD > 0 Then MsgBox "Ci sono " & ContaD & " operazioni uguali, verificare! ", vbExclamation
End Sub