Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[EXCEL] Caricamento dati da files con accodamento

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] Caricamento dati da files con accodamento

Postdi fcudia » 29/07/09 13:49

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
fcudia
Utente Junior
 
Post: 37
Iscritto il: 20/06/09 14:53

Sponsor
 

Re: [EXCEL] Caricamento dati da files con accodamento

Postdi Flash30005 » 29/07/09 13:51

fcudia ha scritto:Per il resto ho qualche idea, la razionalizzo e ti faccio sapere


Ok, attendo tue notizie

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Caricamento dati da files con accodamento

Postdi fcudia » 31/07/09 12:37

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
fcudia
Utente Junior
 
Post: 37
Iscritto il: 20/06/09 14:53

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL] Caricamento dati da files con accodamento":


Chi c’è in linea

Visitano il forum: Nessuno e 9 ospiti