18. juni 2018 - 12:09Der 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.
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?
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
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.
