Avatar billede Jeppe Novice
09. juli 2020 - 15:58 Der er 3 kommentarer og
1 løsning

Gentag VBA kode for hver kolonne

Jeg håber nogen af jer kloge hoveder kan hjælpe mig. Det skal lige siges, at jeg bestemt ikke er god til VBA.

Problemet er:
Jeg har en række varenr. (i celle B2 til B21 i Ark2) som jeg filtrerer i Ark1. Resultatet af denne filtrering bliver smidt over i Ark2 fra celle B22 og ned.

Denne øvelse vil jeg meget gerne gentage på kolonne C, D, E, F........ (indtil der ikke er flere varenr. - hvis øverste linje er tom, er cellerne nedefter også tomme). 


Nedenfor er den kode jeg bruger
-----------------------------------------------------------------------------------------
Sub Niveau_2()

Dim Ark1_sh As Worksheet
Dim Ark2_Sh As Worksheet
Set Ark1_sh = ThisWorkbook.Sheets("Data")
Set Ark2_Sh = ThisWorkbook.Sheets("Output")

Ark1_sh.AutoFilterMode = False


Dim Emp_list() As String
Dim n As Integer
n = 20
ReDim Emp_list(n) As String
Dim i As Integer
For i = 0 To n
    Emp_list(i) = Ark2_Sh.Range("B" & i + 2)
Next i


Ark1_sh.UsedRange.AutoFilter 1, Emp_list(), xlFilterValues
Ark1_sh.Range("B:B").Copy Ark2_Sh.Range("B22")

Ark1_sh.AutoFilterMode = False

End Sub
------------------------------------------------------------------------------------------------

Hvis I kan må I også meget gerne fjerne den midterste del, hvor jeg definerer Emp_list(). Kriterierne for filtreringen vil altid være henholdsvis B2 til B21, C2 til C21, D2 til D21 ...... i Ark2, jeg ved bare ikke hvordan jeg får det ind i "Ark1_sh.UsedRange.AutoFilter 1, Emp_list(), xlFilterValues".


Opsumering:
Jeg vil gerne have en VBA som filtrere varenumrene i celle B2 til B21 i en liste jeg har i Ark1, og som smider resultatet af filtreringen i celle B22. Derefter skal den filtrere varenumrene i celle C2 til C21 og smide dette resultat i celle C22 osv.

Jeg har over 100.000 kolonner, så jeg vil blive meget glad hvis nogen kan hjælpe. 

Koden ovenfor virker perfekt, den skal bare gøre det samme for kolonne C, D, E osv.
Avatar billede Jeppe Novice
10. juli 2020 - 13:38 #1
Jeg har løst den midterste del, så nu mangler jeg bare at finde en løsning til at gøre B'et variabelt i "B2:B21" og "B22". Så når kolonne B er kørt igennem, skal den gøre helt det samme for kolonne C. Jeg tænker en eller anden form for loop??

------------------------------------------------------------------------------------------------------

Sub Niveau_2()

Dim Ark1_sh As Worksheet
Dim Ark2_sh As Worksheet

Set Ark1_sh = ThisWorkbook.Sheets("Data")
Set Ark2_sh = ThisWorkbook.Sheets("Output")

Ark1_sh.AutoFilterMode = False


Dim Emp As Variant

    Emp = Ark2_sh.Range("B2:B21")
    Emp = Application.Transpose(Emp)
    Emp = Join(Emp, ",")
    Emp = Split(Emp, ",")
   

Ark1_sh.UsedRange.AutoFilter 1, Emp, xlFilterValues
Ark1_sh.Range("B:B").Copy Ark2_sh.Range("B22")

Ark1_sh.AutoFilterMode = False

End Sub
Avatar billede bsn Forsker
12. juli 2020 - 12:09 #2
100.000 kolonner - det mange...
Lidt off topic - Jeg ville lave en databaseløsning...:)
Avatar billede Jeppe Novice
13. juli 2020 - 08:21 #3
@bsn jeg er ikke sikker på hvad du mener med en databaseløsning. Problemet er lidt, at målet med denne opgave er at lave netop en database, så det bliver lettere at slå de enkelte varer op senere.

Jeg har selv fundet en løsning, og den var egentlig meget simpelt. I får den lige nedenfor, så andre også kan se den hvis de skulle få brug for det.

-------------------------------------------------------------------------------------------------------
Sub Niveau_2()

FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To FinalColumn


Dim Ark1_sh As Worksheet
Dim Ark2_sh As Worksheet

Set Ark1_sh = ThisWorkbook.Sheets("Data")
Set Ark2_sh = ThisWorkbook.Sheets("Output")

Ark1_sh.AutoFilterMode = False


Dim Emp As Variant

    Emp = Ark2_sh.Range(Cells(2, i), Cells(21, i))
    Emp = Application.Transpose(Emp)
    Emp = Join(Emp, ",")
    Emp = Split(Emp, ",")
   

Ark1_sh.UsedRange.AutoFilter 1, Emp, xlFilterValues
Ark1_sh.Range("B:B").Copy Ark2_sh.Cells(22, i)

Ark1_sh.AutoFilterMode = False


Next i


End Sub
Avatar billede bsn Forsker
13. juli 2020 - 11:24 #4
#3
Access database...
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester