VBA Code Loop probleem

Status
Niet open voor verdere reacties.

DuckieNL

Gebruiker
Lid geworden
8 mrt 2010
Berichten
5
Beste Iedereen,
hierbij het script wat ik tot nu toe gemaakt heb.
het is de bedoeling dat onderstaande script in een excel bestand zoekt naar "MFN " en dan die rij verwijderd,
en dit dan blijft doen todat alle rijen gecontroleerd zijn. en dus alle rijen met MFN weg zijn.
hierna moet de Sub afsluiten

ik krijg het wel voor elkaar dat dit script er 1 verwijderd, als MFN niet voorkomt dan komt VBA met een foutmelding.

heeft iemand een idee hoe ik dit kan oplossen?

Code:
Sub DeleteMFN()

Dim i As Long

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    For i = Selection.Rows.Count To 1 Step -1
If Cells.Find(What:="MFN ", LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=x1Previous, MatchCase:= _
        False, SearchFormat:=False).Activate Then
    Selection.Rows().EntireRow.Delete
    Else
    Exit For
            End If
            
   Next i


        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

Alvast ontzettend bedankt voor je moeite!!!
Greets
DuckieNL
 
Code:
Sub test()
  On Error Resume Next
  Do
    With Sheets("Blad1").UsedRange.Find("MFN", , xlValues, xlWhole).EntireRow
       .Delete
     End With
  Loop Until Err.Number > 0
End Sub
 
of
Code:
Sub tst()
  With Sheets(1).UsedRange
    .Offset(, .Columns.Count + 2).Resize(, 1) = "*"
    For Each rw In .Rows
       If Not rw.Find("MFN", , xlValues, xlWhole) Is Nothing Then Cells(rw.Row, .Columns.Count) = ""
    Next
    with Sheets(1).Columns(.Columns.Count)
      .SpecialCells(4).EntireRow.Delete
      .clear
    End With
  End with
End Sub
 
@ snb
Wat is het voordeel van het gebruik van jouw code tegenover de mijne ? Of is het gewoon een andere aanpak ?
Zoals ik het begrijp zet je naast elke kolom een "*" dat je verwijdert als de waarde in die regel gevonden wordt. Daarna worden alle regels met een lege cel in die kolom verwijdert met specialcells.
Graag een woordje uitleg.
 
Code:
Sub test()
  On Error Resume Next
  Do
    With Sheets("Blad1").UsedRange.Find("MFN", , xlValues, xlWhole).EntireRow
       .Delete
     End With
  Loop Until Err.Number > 0
End Sub

Hey bakkertje,
Onwijze bedankt voor je snelle reactie.
helaas werk bovenstaande niet, ik zal zo nog een voorbeeld bestandje toevoegen misschien is het heel simpel maar ik zie niet wat er misgaat.
Greets
Duckie
 
of
Code:
Sub tst()
  With Sheets(1).UsedRange
    .Offset(, .Columns.Count + 2).Resize(, 1) = "*"
    For Each rw In .Rows
       If Not rw.Find("MFN", , xlValues, xlWhole) Is Nothing Then Cells(rw.Row, .Columns.Count) = ""
    Next
    with Sheets(1).Columns(.Columns.Count)
      .SpecialCells(4).EntireRow.Delete
      .clear
    End With
  End with
End Sub

Hey snb,
helaas werk ook jouw code niet.
nu verdwijnt de hele kolom inplaats van de rij.
zoals ik net oook al zei zal ik een voorbeeld bestandje uploaden

Greets
DuckieNL
 
Laatst bewerkt:
Hier een voorbeeld van zo'n sheet.

het gaat er dus om dat regel 7tm 12 weg gaan maar dit zijn iedere keer andere aantallen en ze staan op verschillende plekken.
het enige wat iedere keer het zelfde is is "MFN " (MFNspatie)

overigens is het allen kolom G waar in gezocht hoeft te worden.

[XML]Wie is dit? wat welke Naam Product Naam Product Code Product
Naam Code -1 Afdeling Standaard TFT-beeldscherm 244 Scherm01
Naam Code -1 Afdeling Standaard TFT-beeldscherm 244 Scherm02
Naam Code -1 Afdeling Standaard TFT-beeldscherm 244 Scherm03
Naam Code -1 Afdeling Standaard TFT-beeldscherm 244 Scherm04
Naam Code -1 Afdeling Standaard TFT-beeldscherm 244 Scherm05
Naam Code -1 Afdeling Multifunctional Papier 431B MFN 431B
Naam Code -1 Afdeling Multifunctional Papier 431C MFN 431C
Naam Code -1 Afdeling Multifunctional Papier 432B MFN 432B
Naam Code -1 Afdeling Multifunctional Papier 432C MFN 432C
Naam Code -1 Afdeling Multifunctional Papier 431B MFN 431B
Naam Code -1 Afdeling Multifunctional Papier 431C MFN 431C
Naam Code -1 Afdeling Multifunctional 431 Printer
Naam Code -1 Afdeling Multifunctional 432 Printer
[/XML]

Wederom onwijze bedankt voor jullie snelle reacies!
Greets

DuckieNL
 
Heren Bedankt!!!
het is me gelukt...
het was inderdaad toch simpeler dan ik eerst dacht :)
nu maar hopen dat dit ook snel gaat als er 500x die MFN instaan
Code:
Sub DeleteMFN()
    On Error Resume Next
    Do
    Cells.Find(What:="MFN", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).EntireRow.Delete
    Loop Until Err.Number > 0
    
End Sub
 
als het alleen om kolom G gaat:

Code:
Sub simpel()
  columns(7).replace "MFN",""
  columns(7).specialcells(4).entirerow.delete
End Sub

@Rudi
het sequentieel verwijderen van hele rijen wil bij Excel nog wel eens problemen opleveren.
Om dat te voorkomen verwijder ik meestal gegevens uit een kolom, waarna daarna simultaan alle te verwijderen rijen verwijderd worden op basis van lege cellen in een kolom. (ook in termen van screenupdating en recalculation is dat efficiënter).
Mijn code-suggestie behoeft op dat punt ook nog wel verbetering.
Maar jouw code is prima overzichtelijk en kan beperkt worden tot
Code:
Sub test()
  On Error Resume Next
  Do
    Sheets("Blad1").UsedRange.Find("MFN", , xlValues, xlWhole).EntireRow.Delete
  Loop Until Err.Number > 0
End Sub

een combinatie van beide:
Code:
Sub test2()
  On Error Resume Next
  Do
    Sheets(1).UsedRange.Find("MFN", , xlValues, xlWhole).EntireRow.Clear
  Loop Until Err.Number > 0
  sheets(1).columns(1).specialcells(4).entrirerow.delete
End Sub
of als je screenupdating en calculate helemaal wil vermijden
Code:
Sub test3()
  Do
    c2= c2 & "," & c1
    c1=Sheets(1).UsedRange.Find("MFN", , xlValues, xlWhole).Address 
   Loop Until instr(c2,c1) > 0
  sheets(1).range(mid(c2,2)).entirerow.delete
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan