PDA

Visualizza versione completa : [excel 2003] filtraggio dati con macro


Thor
27-12-2005, 10.27.33
semplificando, ho questo file con due colonne, A e B, entrambe numeriche.

un dato della colonna B può corrispondere a più dati della colonna A (associazione 1 -> molti)

è possibile tirar fuori solo le righe in cui capita questa associazione multipla?

grazie.

Thor
27-12-2005, 16.29.52
premesso che non mi intendo di programmazione excel+vba, con le 2 istruzioni che conosco, ho fatto questo scriptino:

Sub filtro()
w = ActiveSheet.Cells(1, 1).End(xlDown).Row
j2 = 1
For i = 1 To w Step 1
nome = Cells(i, 2).Value
For i2 = 1 To j2 Step 1
If Cells(i2, 4).Value = nome Then GoTo ipiuuno
Next
Cells(j2, 4) = nome
Cells(j2, 5) = Cells(i, 1).Value
j2 = j2 + 1
cont = 0
For j = i + 1 To w Step 1
If Cells(j, 2).Value = nome Then
cont = cont + 1
Cells(j2, 5).Value = Cells(j, 1).Value
j2 = j2 + 1
End If
Next
If cont = 0 Then
j2 = j2 - 1
Cells(j2, 4) = ""
Cells(j2, 5) = ""
End If
ipiuuno:
Next
End Sub


che funziona. ma mi sembra troooppo prolisso. di certo, chi conosce la sintassi di vba, lo sa fare in poche righe di codice.

in sostanza, l'output deve essere una cosa del genere:

http://x12.putfile.com/12/36009311354.jpg

un'altra cosa..come si fa a far partire la macro automaticamente col file excel all'apertura? e a ricaricarla se cancello manualmente la zona dei risultati?

grazie! :)

Cricchia
27-12-2005, 16.49.17
per far partire la macro all'apertura del file, la devi chiamare
sub auto_open()

;)

per il resto... boh! :confused:

Thor
27-12-2005, 16.52.13
Originariamente inviato da Cricchia
per far partire la macro all'apertura del file, la devi chiamare
sub auto_open()

;)

per il resto... boh! :confused: thank you ;)

qui ci vuole un esperto di vba ed excel avanzato, sperem! :cool:

Thor
27-12-2005, 17.06.09
ah..se ho due fogli all'interno del file excel, come gli dico di eseguirla solo ed automaticamente su "sheet1" e non su "sheet2"?

grazie!

Cricchia
27-12-2005, 17.14.40
metti come primissima istruzione
sheet1.activate

oppure gli puoi far controllare il nome del foglio:

Sub Prova()
If ActiveSheet.Name = "Sheet1" Then
MsgBox ("ciao")
Else
MsgBox ("errore")
End If
End Sub


è inutile che ti dica cosa sostituire alle msgbox, vero?!!??! :)

ma scusa, se la macro che hai scritto funziona, tieni quella, no?!?!? ;)

Thor
27-12-2005, 17.33.17
Originariamente inviato da Cricchia
metti come primissima istruzione
sheet1.activate

oppure gli puoi far controllare il nome del foglio:

Sub Prova()
If ActiveSheet.Name = "Sheet1" Then
MsgBox ("ciao")
Else
MsgBox ("errore")
End If
End Sub


è inutile che ti dica cosa sostituire alle msgbox, vero?!!??! :)meglio la prima attivazione, preferisco evitare i msgbox

ma scusa, se la macro che hai scritto funziona, tieni quella, no?!?!? ;) ma io non conosco nulla di vba, solo due istruzioni in croce, con cui ho fatto lo script..il tempo di esecuzione è alto, su 12.000 righe :rolleyes:
dunque penso che chi se ne intende di vba possa scrivere meglio il tutto :)
(ad esempio la parte in cui lo script torna indietro e cancella una riga che aveva scritto ma di cui non ha trovato doppioni..quella parte la devo riguardare in ogni caso)

Dav82
27-12-2005, 18.10.51
Quella parte l'ho guardata già io Thor, e penso che vada bene :) Almeno: io mi ero chiesto se fosse proprio necessario scrivere e poi, non trovati dei doppioni, tornare indietro e cancellare la riga, e mi sono risposto che o si usa una sentinella che segnala il primo doppione trovato e la si usa, con un if, per inserire questi valori (ma la complessità resta identica o aumenta) oppure si usa una variabile in cui si memorizza il valore originario di j2 e poi, nel caso, si la si sfrutta: ma anche qui la complessità rimane la medesima, se non ho preso un abbaglio :)


Anche come algoritmo direi che ci siamo, almeno pensandoci tre minuti non mi viene in mente niente di meglio.
Piuttosto ti direi di provare un'altra cosa, ma non so se sia sensata e fattibile. Probabilmente le funzioni di excel sono scritte in maniera super-super-ottimizzata, quindi sfruttarle è un'idea per diminuire i tempi di elaborazione... forse :)

Si possono usare?

Dav82
27-12-2005, 18.32.06
Oppure... ok, il problema si "stravolge" un pochino, ma importare i dati in un DB e scrivere una semplice query? :)

VALORI (Campo1, Campo2)


SELECT *
FROM VALORI
WHERE Campo2 IN (SELECT Campo2
FROM VALORI
GROUP BY Campo2
HAVING COUNT (Campo2) > 1)


Ovviamente se hai a disposizione un DBMS :o

Thor
27-12-2005, 19.19.03
mmh..farlo con db + sql non è fattibile.

per quel che riguarda le funzioni di excel, non so se ne esistano così ottimizzate. a dire il vero non ho ancora cercato a fondo..

Dav82
27-12-2005, 19.28.47
A me era venuto in mente di usare il CERCA.VERT, però prende un solo valore alla volta, sarebbe più utile se restituisse tutti i valori corrispondenti al valore cercato (purtroppo non è una funzione tabellare, almeno a quanto so e ho potuto vedere).
Se poi i valori che hai sono noti, per dire da 1 a 1000, puoi anche usare il CONTA.SE per contare le occorrenze di un determinato valore e decidere su usare un ciclo con il CERCA.VERT (*) per trovare tutti i valori.


(*) siccome il CERCA.VERT restituisce solo il corrispondente del primo valore trovato, si cicla facendo partire di volta in volta la tabella di ricerca dalla cella successiva, verso il basso, a quella in cui si è trovata l'ultima occorrenza... in sostanza il CERCA.VERT va a rimpiazzare il corpo del tuo ciclo su j.

NB: ocio che per utilizzare il CERCA.VERT devi invertire l'ordine delle colonne nella tabella: prima il campo "indice", poi il campo "valori" :)




Però io di VBA non conosco nulla, quindi non ti so dare la risposta che cerchi ;)

LoryOne
28-12-2005, 12.46.41
Io proporrei questa porzione di codice:


Private Const nRows As Integer = 12000

Private Type Struct
nBound As Integer
nValue(1 To nRows) As Integer
End Type

Public Sub Filtro()
Dim Letter(97 To 122) As Struct
Dim r As Integer

ActiveSheet.Cells(1, 1).Select
For r = 1 To nRows
Letter(Asc(Cells(r, 2).Value)).nBound = _
Letter(Asc(Cells(r, 2).Value)).nBound + 1
Letter(Asc(Cells(r, 2).Value)).nValue(Letter(Asc(Cells(r, 2).Value)).nBound) = _
Cells(r, 1).Value
Next
End Sub


In questo modo in una sola passata ottieni velocemente ogni singolo elemento dell'array Letter corrispondente ad ogni singola lettera dalla 'a' alla 'z'.
Il codice effettua la verifica su 12000 righe.
nBound indica la ricorrenza della lettera
nValue è un array da 1 a nBound contenente i valori.
A questo punto scriverli come nel tuo esempio è un gioco da ragazzi ;)

Thor
28-12-2005, 12.59.49
grazie, mi dovevo studiare il vba :D

comunque, già che ci siamo, puoi per favore aggiungere il codice per l'output in modo che sia come il mio, e magari far sì che si possa mantenere la variabile w (o comunque fare un check dinamico sul numero di entrate/righe)?

thank you! :) (Y)

LoryOne
28-12-2005, 15.02.42
Codice rivisitato


Private Type Struct
nBound As Long
nValue() As Long
End Type

Public Sub Filtro(ByVal nRows As Long)
Dim Letter(97 To 122) As Struct
Dim r As Long, v As Byte ', z As Long
'Dim s As String

ActiveSheet.Cells(1, 1).Select
For r = 1 To nRows
v = Asc(Cells(r, 2).Value)
Letter(v).nBound = Letter(v).nBound + 1
ReDim Preserve Letter(v).nValue(Letter(v).nBound)
Letter(v).nValue(Letter(v).nBound) = Cells(r, 1).Value
Next
'For r = 97 To 122
' s = s & "Lettera " & Chr$(r) & " "
' For z = 1 To Letter(r).nBound
' s = s & Letter(r).nValue(z) & IIf(z < Letter(r).nBound, ",", vbNullString)
' Next
' s = s & vbCrLf
'Next
'MsgBox s
End Sub


A te basta inserire un commandbutton in uno qualsiasi dei fogli che tì interessano.
All'interno dell'evento Click richiamare Filtro passandogli come parametro il numero di righe che t'interessano (possono essere differenti da foglio a foglio...per quello che ho impostato un parametro che imposterai tu ogni volta).
Per quanto riguarda il codice per l'output...dai, fallo tu :)

LoryOne
28-12-2005, 21.57.28
Puoi ulteriormente limare qualche millisecondo con questo codice:


Private Type Struct
nBound As Long
nValue() As Long
End Type

Public Sub Filtro(ByVal nRows As Long)
Dim Letter(97 To 122) As Struct
Dim r As Long, v As Byte, z As Long
Dim s As String

ActiveSheet.Cells(1, 1).Select
For r = 1 To nRows
v = Asc(Cells(r, 2))
With Letter(v)
.nBound = .nBound + 1
ReDim Preserve .nValue(.nBound)
.nValue(.nBound) = Cells(r, 1)
End With
Next


Su un Athlon XP 2400+ impiega 1,46 secondi per 65536 righe.
Mi sembra un tempo di tutto rispetto. :)

LoryOne
29-12-2005, 22.10.44
Script completo (se Thor non ha ancora risolto)


Private Type Struct
nBound As Long
nValue() As Long
End Type

Public Sub Filtro(ByVal nRows As Long)
Dim Letter(97 To 122) As Struct
Dim r As Long, v As Byte, z As Long , t As Long

For r = 1 To nRows
v = AscW(Cells(r, 2))
With Letter(v)
.nBound = .nBound + 1
ReDim Preserve .nValue(.nBound)
.nValue(.nBound) = Cells(r, 1)
End With
Next

t = 0
r = 97
Do Until r > 122
z = 1
With Letter(r)
While z <= .nBound
t = t + 1
If z = 1 Then Cells(t, 4) = ChrW(r)
Cells(t, 5) = .nValue(z)
z = z + 1
Wend
End With
r = r + 1
Loop
End Sub

Thor
29-12-2005, 23.05.15
scusa LoryOne, oggi non sono riuscito a dare neppure un'occhiata al lavoro excel..dunque ti ringrazio ancor prima di guardare gli script!

davvero, grazie! (Y)

LoryOne
30-12-2005, 11.39.09
Scusa di che ?
Son mica io che ti pago :D