[vba] semplice macro

[ramset1978]

Ragazzi ci ho provato in tutti i modi senza riuscirci.

Ho un file excel che contiene dati dalla colonna A alla colonna S.

Il vorrei una macro che estrapoli in ordine cronologico (colonna E), le riga in cui vi sia una determinata banca (es. Iwbank).

Questo è l'allegato: http://www.filedropper.com/cartel2

Se qualcuno ha voglia di darmi una mano gliene sarei grato, sono certo che i più bravi ci metteranno pochi minuti.

Grazie anticipato, saluti.

P.s. dimenticavo, ogni volta che la macro viene lanciata deve cancellare i dati del nuovo foglio e ripartire da capo. Questo perchè nel frattempo potrebbe essere cambiato l'ordine dai dati inseriti nel foglio originale.

[Anthony47]

La macro e' abbastanza semplice e puoi registrarla sul tuo pc.
Parti dal foglio con i tuoi dati e impostaci il filtro automatico (Nota*) sulla colonna A; poi:
-avvia la registrazione di macro
-seleziona il foglio di output, seleziona le colonne A:Z, cancella il contenuto; seleziona la cella A1
-torna al foglio dati
-imposta il filtro per selezionare il dato Iwbank
-copia tutte le colonne A:S
-vai sul foglio di output, seleziona la cella A1 (ma dovrebbe essere gia' selezionata), incolla i dati
-premi il tasto Esc
-seleziona le colonne A:S ed esegui un ordinamento su colonna E
-torna sul foglio di origine e, nel filtro di colonna A, scegli di visualizzare tutte le righe.
-interrompi la registrazione
La tua macro, anche se non ottimizzata, e' pronta per essere eseguita quando ti serve; eventualmente associala a un pulsante.
Nota*: per il corretto uso del fitro, la tabella deve avere una intestazione in riga1; non so come nasce quella tabella, quindi non so se basta inserire Riga1 con le intestazioni una sola volta e ti rimane per sempre o se invece i tuoi dati saranno sempre senza intestazione; in questa seconda ipotesi dovrai inserire la riga e mettere l'intestazione almeno in colonna A subito dopo aver avviato la registrazione della macro.

Se vuoi filtrare non sempre Iwbank, allora:
-scrivi il valore da filtrare in Z1
-cerca l'istruzione che applica il "criterio" al filtro e invece di = "Iwbank" sostituisci con =Range("Z1").Value

Ciao

[ramset1978]

Grazie Anthony, ma è proprio quello che avevo provato a fare senza riuscirci. Grazie comunque.

[Anthony47]

Segui le istruzioni passo passo, e se non funziona pubblica il codice che ottieni e vedremo insieme dove e' l'inghippo...

[ramset1978]

Il file ha una riga di intestazione, quello che vedi è solo l'estrapolazione di una piccola parte. Stasera riprovo.... ma non avresti fatto prima a scrivermi due righe di codice anzichè ciò che hai scritto? Grazie, un saluto.

[Anthony47]

Si, confermo: avrei fatto prima a darti il codice; ma ho voluto fare di piu' spiegando come si puo' fare...

[ramset1978]

Va bene grazie. Comunque quella macro crea un filtro che avrei voluto evitare. Bastava semplicemente che copiasse i dati interessati. Anche perchè sono tanti. Comunque va ben cosi. Grazie. Saluti.

[ramset1978]

Anthony sono riuscito in qualche modo a creare la macro. Il problema è lentezza (legge oltre 3.000 dati). So che esiste un modo per evitare che la macro vada a leggere ad ogni singolo rigo i dati (in pratica li memorizza). Potresti darmi una mano a trasformarla?
Tieni presente che il foglio originale è chiamato "InsDati" e che il foglio di destinazione è chiamato "Dett_Iwbank".
Grazie

Codice: Seleziona tutto

' ================================
' INCOLONNA PER BANCA (Iwbank)
' ================================
Private Sub Incolonna_Iwbank()
Application.ScreenUpdating = False
Dim RigNum     As Long
Dim x         As Long
Dim y         As Long

Sheets("InsDati").Select
RigNum = Application.WorksheetFunction.CountA(Columns("A"))

Sheets("Dett_Iwbank").Select
Range(Cells(2, 1), Cells(1048576, 18)).ClearContents

y = 1
For x = 2 To RigNum
Sheets("InsDati").Select
If Cells(x, 1) = "Iwbank" Then
y = y + 1
Range(Cells(x, 1), Cells(x, 18)).Select
Selection.Copy

Sheets("Dett_Iwbank").Select
Range(Cells(y, 1), Cells(y, 18)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next x

Exita:
'riposiziono il cursore nelle prima cella vuota
Sheets("InsDati").Select
Cells(x, 1).Select

'autoadatta larghezza colonne
Sheets("Dett_Iwbank").Select
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select

'riposiziono il cursore sulla prima cella vuota
Cells(y + 2, 1).Select
End Sub



[Anthony47]

A volte non vi capisco: comperate Excel e poi preferite evitare di usare le cose furbe che ci sono dentro, ad esempio il filtro automatico, optando per altre soluzioni che poi sono da epilessia... Mah...
Cio' detto:

Codice: Seleziona tutto

Sub zzz()
Dim WsSorg As Worksheet, WsDett As Worksheet
Dim I As Long, RigNum As Long, myNext As Long, myBank As String
'
Set WsSorg = Sheets("InsDati")          '<<< Foglio di Origine
Set WsDett = Sheets("Dett_Iwbank")      '<<< Foglio per elenco filtrato
myBank = "Iwbank"                       '<<< banca
'
mytim = Timer
WsDett.Select
    Range("A1").Resize(Rows.Count, 18).Clear
    RigNum = WsSorg.Cells(Rows.Count, 1).End(xlUp).Row
    For I = 2 To RigNum
        If WsSorg.Cells(I, 1) = myBank Then
            myNext = myNext + 1
            Cells(myNext, 1).Resize(1, 18).Value = WsSorg.Cells(I, 1).Resize(1, 18).Value
        End If
    Next I
Cells(myNext + 1, 1).Select
WsSorg.Range("A2:S2").Copy
Range("A1").Resize(myNext, 18).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A:S").Columns.AutoFit
MsgBox ("Completato " & Format(Timer - mytim, "00.00"))
End Sub


Le righe marcate <<< potrebbero essere da personalizzare.
Su un file con 3600 record ha impiegato 2.5 secondi, che comunque e' il doppio di quanto si ottiene con il filtro automatico.

Ciao.

[ramset1978]

Funziona molto più veloce della mia... unica cosa è che se aggiungo una condizione (non ci avevo pensato prima) la macro va in errore. La condizione è che il rigo oltre a contenere il nome della banca nella colonna 1 deve contenere nella colonna 4 la parole Long oppure Short.

Sub zzz()
Dim WsSorg As Worksheet, WsDett As Worksheet
Dim I As Long, RigNum As Long, myNext As Long, myBank As String
'
Set WsSorg = Sheets("InsDati") '<<< Foglio di Origine
Set WsDett = Sheets("Dett_Iwbank") '<<< Foglio per elenco filtrato
myBank = "Iwbank" '<<< banca
'
mytim = Timer
WsDett.Select
Range("A1").Resize(Rows.Count, 18).Clear
RigNum = WsSorg.Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To RigNum
If WsSorg.Cells(I, 1) = myBank and (cells(I,4)= "Long" or cells(I,4)="Short") Then
myNext = myNext + 1
Cells(myNext, 1).Resize(1, 18).Value = WsSorg.Cells(I, 1).Resize(1, 18).Value
End If
Next I
Cells(myNext + 1, 1).Select
WsSorg.Range("A2:S2").Copy
Range("A1").Resize(myNext, 18).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A:S").Columns.AutoFit
MsgBox ("Completato " & Format(Timer - mytim, "00.00"))
End Sub

[ramset1978]

Dimenticavo, la macro deve cancellare all'inizio tutti i dati a partire dalla riga 2 e dalla stessa deve iniziare a scrivere. Come hai sottolineato tu nel primo post, vi è ovviamente una riga d'intestazione. Grazie Anthony per la tua disponibilita'.

[Anthony47]

Tanto per infierire, col filtro automatico tutte le cose che hai detto (condizioni aggiuntive, cancellazione vecchio elenco, intestazioni in colonna 1 e inizio da colonna 2) sarebbero gia' incluse nella macro registrata.
Con macro:

Codice: Seleziona tutto

Sub zzz2()
Dim WsSorg As Worksheet, WsDett As Worksheet
Dim I As Long, RigNum As Long, myNext As Long, myBank As String
'
Set WsSorg = Sheets("InsDati")          '<<< Foglio di Origine
Set WsDett = Sheets("Dett_Iwbank")      '<<< Foglio per elenco filtrato
myBank = "Iwbank"                       '<<< banca
'
mytim = Timer
WsDett.Range("A2").Resize(Rows.Count - 1, 18).Clear     '***
WsDett.Select
    Range("A1").Resize(Rows.Count, 18).Clear
    RigNum = WsSorg.Cells(Rows.Count, 1).End(xlUp).Row
    For I = 2 To RigNum
        If WsSorg.Cells(I, 1) = myBank And (WsSorg.Cells(I, 4) = "Long" Or WsSorg.Cells(I, 4) = "Short") Then
            myNext = myNext + 1
            Cells(myNext, 1).Resize(1, 18).Value = WsSorg.Cells(I, 1).Resize(1, 18).Value
        End If
    Next I
Cells(myNext + 1, 1).Select
WsSorg.Range("A2:S2").Copy
Range("A1").Resize(myNext, 18).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A:S").Columns.AutoFit
MsgBox ("Completato " & Format(Timer - mytim, "00.00"))
End Sub

Le intestazioni del foglio Dettaglio le copierai a mano la prima volta.

Ciao

[ramset1978]

Grazie Anthony, grazie mille. Ciao

[ramset1978]

Anthony, ti devo rompere di nuovo perchè non riesco a venire a capo di due piccoli particolari.
La prima riga del file "destinazione" non deve essere ne cancellata ne scritta (ci sta un'intestazione), mentre la "formattazione" copiata deve essere non quella della seconda riga del file "sorgente" ma quella della terza riga. Eh si che ci ho smanettato ma finisce che faccio casino.... per favore, grazie.

[Anthony47]

Per quanto riguarda la riga 1, in effetti nel codice avevo inserito l'istruzione che cancellava da riga 2, ma avevo lasciato la precedente che puliva da riga 1 [Range("A1").Resize(Rows.Count, 18).Clear], che ovviamente deve essere eliminata.

Quanto alla formattazione, la riga da modificare e' WsSorg.Range("A2:S2").Copy + la successiva:

Codice: Seleziona tutto

WsSorg.Range("A3:S3").Copy
Range("A2").Resize(myNext, 18).PasteSpecial xlPasteFormats


Ciao

[ramset1978]

Grazie Genio!