Avatar billede Latte Mester
18. juni 2018 - 12:09 Der er 5 kommentarer og
1 løsning

EntireRow.Delete og sortér/kopier/loop

I worksheet "Basis" har jeg data i A1:N:198. I N er 98 kontonumre repræsenterede

1) Såfremt et kontonr. i N ikke er lige med ét af 15 angivne kontonumre, så skal rækken fjernes/slettes.

2) I C: såfremt de første 4 karakterer = "UPR:", så skal rækken fjernes/slettes.

3) Find i F første forekomst at "LB". Kopier hele rækken fra worksheet "Basis" til worksheet "LB" række 1
Find i F næstkommende forekomst af "LB". Kopier hele rækken til worksheet "LB" række 3
...dernæst til række 5 og fremdeles.

4) Find i F første forekomst at "LFQ". Kopier hele rækken fra worksheet "Basis" til worksheet "LFQ" række 1
Find i F næstkommende forekomst af "LFQ". Kopier hele rækken til worksheet "LB" række 3
...dernæst til række 5 og fremdeles.

Kan nogen mon hjælpe?
Avatar billede jens48 Ekspert
18. juni 2018 - 23:46 #1
Din beskrivelse er ret detaljeret, så det skulle ikke være så svært. Det mangler blot en enkelt detalje. Hvor har du dine 15 angivne kontonumre stående?
Avatar billede Latte Mester
19. juni 2018 - 09:00 #2
De kunne stå i et worksheet "Kontonumre"
Avatar billede finb Ekspert
19. juni 2018 - 09:38 #3
Hvis det er en eksamensopgave,
har du stor fordel af at løse den selv.
Avatar billede Latte Mester
19. juni 2018 - 10:05 #4
God pointe. Det er det heldigvis/desværre ikke :)  Jeg forlod skolen en gang midt i '80'erne.
Avatar billede jens48 Ekspert
19. juni 2018 - 23:51 #5
Måske kan dette bruges. Jeg antager at de 15 kontonumre står i cellerne A1:A15. Ellers ret i linje 5

Sub SletOgFlyt()
Dim Rk, x As Integer
For Rk = 198 To 1 Step -1
If Application.CountIf(Worksheets("Kontonumre").Range("A1:A15"), Cells(Rk, 14)) = 0 Then
Rows(Rk).Delete
End If
Next Rk
For Rk = 198 To 1 Step -1
If Left(Cells(Rk, 3), 4) = "UPR:" Then
Rows(Rk).Delete
End If
Next Rk
x = 1
For Rk = 1 To 198
If IsNumeric(Application.Search("LB", Cells(Rk, 6))) Then
Rows(Rk).Copy Destination:=Worksheets("LB").Cells(x, 1)
x = x + 2
End If
Next Rk
x = 1
For Rk = 1 To 198
If IsNumeric(Application.Search("LFQ", Cells(Rk, 6))) Then
Rows(Rk).Copy Destination:=Worksheets("LFQ").Cells(x, 1)
x = x + 2
End If
Next Rk
End Sub
Avatar billede jens48 Ekspert
21. juni 2018 - 00:30 #6
Ret i linje 4, ikke 5
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