Z AutoFiltrom poskušam avtomatizirati iskanje parov in njihovo kopiranje na nov list v delovnem zvezku. Samo kopiranje ne predstavlja težave, se pa te pojavljajo v povezavi z dinamičnim spreminjanjem vrednosti v polju "Criteria1" in ponavljajočimi zankami. V omenjenem polju si želim, da bi se obdelale vse vrednosti, ki se pojavljajo v stolpcu in posledično v spustnem seznamu (kar je po mojem hitreje, kot če bi določil obseg vrednosti in bi se koda izvedla za vse vrednosti, ne glede na to, ali so prisotne v stolpcu). Kot sem pri prebiranju internetnih vsebin razumel, zadeve ni mogoče rešiti brez pomožnega stolpca (stolpcev), v katerega se najprej izvleče enovite vrednosti. Te se v vseh stolpcih začnejo v drugi vrstici, njihovo število pa ni vedno enako.
S pomočjo interneta sem sestavil kodo
Koda: Izberi vse
Sub AutoFilter()
Dim c As Range
Dim cc As Range
Dim iCol As Long
Dim r As Range
Set r = Sheets(1).Range("A1")
Range("A1:A" & Rows.Count).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True 'izvleče enovite vrednosti iz stolpca A v stolpec J
Range("C1:C" & Rows.Count).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L1"), Unique:=True 'izvleče enovite vrednosti iz stolpca C v stolpec L
For Each c In Range("J2", Range("J" & Rows.Count)).End(xlUp) 'ta del naj bi predstavljal prvi par in začetek ponavljajoče zanke
r.AutoFilter Field:=1, Criteria1:=c.Value
r.AutoFilter Field:=2, Criteria1:="=" & c.Value + 1
For Each cc In Range("L2", Range("L" & Rows.Count)).End(xlUp) 'ta del naj bi predstavljal drugi par in začetek 2. ponavljajoče zanke
r.AutoFilter Field:=3, Criteria1:=cc.Value
r.AutoFilter Field:=4, Criteria1:="=" & cc.Value + 1
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select 'kopiranje na nov list
If IsEmpty(ActiveCell) = True Then
Application.Goto Range("A1")
Else
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(2).Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Sheets(2).Paste
Sheets(1).Activate
Selection.ClearContents
r.Select
End If
Next cc 'naj bi ponovilo drugo zanko dokler so vrednosti stolpca L večje od vrednosti stolpca J oz. J+1, vendar gre takoj na "Next c"
Next c
End Sub
Večja težava je, da mi v AutoFilter ne "potegne" vseh enovitih vrednosti (eno za drugo), temveč vzame le eno in nato zaključi. Poleg tega pa ponavljajoči zanki ne delujeta, kot bi pričakoval (verjetno sta težavi povezani). Namreč, od ponavljajočih zank ("c" in "cc"), želim, da se najprej odvije druga zanka ("cc") z vsemi vrednostmi (ki so večje od vrednosti "c") v povezavi s prvo vrednostjo "c" ter se šele nato vrednost "c" spremeni na naslednjo, kjer se ponovi zanka "cc" itn.
Prosim torej za pomoč:
1. Kako naj kodo prepričam, da bo v povezavi z dinamičnim spreminjanjem polja Criteria1 glede na vrednosti v stolpcu, najprej izvedla vse vrednosti z zanko "cc" in šele nato nadaljevala z novo vrednostjo "c"?
2. Kako preprečiti izvedbo kopiranja kadar filter "skrije" vse podatke in je posledično izbrana celica prazna? (nepotrebno in podaljšuje trajanje izvedbe)
Upam, da moje ideje niso utopične.
Vnaprej hvala za odgovor.
Drago