31. oktober 2003 - 13:48Der er
10 kommentarer og 1 løsning
Hop een tilbage i "for each" next, efter at have slettet row
Hej,
I et ark med 6000 rækker har jeg identificeret en parameter i en bestemt kolonne som skal medføre at række slettes. Jeg selecter kolonnen og kører "for each c in selectin"... next
problemet er, at den sletter en række, og rykker rækkerne en plads op (helt efter hensigten), men efter at have slettet fx række 10, baseret på værdien i G10, går den videre til G11, istedet for at køre G10 igen med den nye celle, som har overtaget pladsen...
For Each c In Selection Debug.Print (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) Debug.Print UCase(c.Value) & " x " & UCase(LocationToBeRemoved) If UCase(c.Value) = UCase(LocationToBeRemoved) Or (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) > 0 Then Debug.Print c.Address & " " & c.Value c.EntireRow.Delete End If Next
Jeg forsøgte at lave det som en While ... Wend løkke, istedet, men får ikke "genindlæst" mit object c.
While UCase(c.Value) = UCase(LocationToBeRemoved) Or (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) > 0 Debug.Print c.Address & " " & c.Value c.EntireRow.Delete
Jeg kan ikke lige gennemskue hvordan man får den til at "køre baglæns", men kunne du ikek nøjes med at Selecte rækkerne i stedet for at delete dem. Når du så har selected dem alle i din for each Next, kunne du slette dem uden for løkken med en
Dim i As Long For i = 15 To 65536 If Cells(i, 20).Value = "Fejl" Then Cells(i, 20).Select 'ActiveCell.EntireRow.Hidden = True ActiveCell.EntireRow.Delete Shift:=xlUp i = i - 1 ' når du sletter en linie rykker den næste op derfor denne linie End If Next i
Enig med jkrons - evt. med en markering af de rækker der skal slettes i seperat kolonne. Erstat "c.EntireRow.Delete" med "c(1, 20) = 1" (kolonne inddrages) og afrund koden med Sub sletkol() Do Cells(1, 20+x).End(xlDown).Select Selection.EntireRow.Delete Loop Until Selection.Row = 65536 End Sub
For Each c In Selection ErSlettet: Debug.Print (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) Debug.Print UCase(c.Value) & " x " & UCase(LocationToBeRemoved) If UCase(c.Value) = UCase(LocationToBeRemoved) Or (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) > 0 Then Debug.Print c.Address & " " & c.Value c.EntireRow.Delete GoTo ErSlettet End If Next
kabbak, mht din GoTo ErSlettet. Der var jeg ikke noget jeg hellere ville end bruge en god gammel "goto" kommando, som eller får røde lamper i øjnene på de fleste teoretikere... :-)
Men jeg får samme fejl som ved min egen "while... wend" nemlig, at den ikke får "grappet" et nyt c-objekt. Dermed er der ikke nogen c.value osv. Alternativ skulle man bryde løkken, lave en ny selektion fra den adresse man lige har slettet, og ned til sidste celle.
Jeg prøver lige de andre forslag af, angående markering og efterfølgende slettelser. Men jeg er ikke sikker på at jeg når det idag - men nok i weekenden...
Du kan med fordel arbejde dig baglæns (det er hurtigere)
Dim lRow As Long Dim rgDel As Range locationcolumnletter = "A" Set rgDel = Range(locationcolumnletter & "1") lRow = Selection.End(xlDown).Row
For x = lRow To 1 Step -1 Set c = Cells(lRow, rgDel.Column) Debug.Print (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) Debug.Print UCase(c.Value) & " x " & UCase(LocationToBeRemoved) If UCase(c.Value) = UCase(LocationToBeRemoved) Or (InStr(1, UCase(c.Value), UCase(LocationToBeRemoved))) > 0 Then Debug.Print c.Address & " " & c.Value c.EntireRow.Delete End If Next
jeg har nu testet bak's løsning, og det er den simpleste løsning, da den klarer det i én omgang. Jeg vil tillade mig at give pointene til Bak, selv om "b hansen" beskriver filosofien bag koden tidligere i forløbet. Det håber jeg er ok, for det var bak, der direkte ledte mig til kode-svaret, som jeg ikke selv lige kunne se. Bak, vil du indsætte et svar :-)
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.
