Verwijderen van regel obv vergelijking

Status
Niet open voor verdere reacties.
L

leonhnoel

Gebruiker
Lid geworden
4 mei 2016
Berichten
58
Hi,

ik heb een stukje code geschreven om op het ene tabblad in één keer alle regels te verwijderen afhankelijk van de inhoud van één van de kolommen (als daar een bepaalde waarde voorkomt wil ik de hele rij verwijderen).

Bekijk bijlage 337015

Iemand een idee waarom ik een foutmelding krijg op de regel

Sheets("Uren").Cells(i, 7).EntireRow.Select

met als melding "methode selecte op klasse range is mislukt"?

Hoor het graag!
leonhnoel
 
zonder het bestand kunnen we daar niks over zeggen.
Kunnen de code niet zelf testen
 
Haal die regel weg en de regel met .Delete ook.
Maak daar dan dit van:
Rows(i).Delete

Zorg er tevens voor dat de loop van hoog naar laag loopt met Step -1:
For i = lNoOfRecords to 3 Step -1
 
Laatst bewerkt:
Korter en wat sneller:

Code: 
Sub SjonR()
With Sheets("Uren").Cells(1).CurrentRegion
    .AutoFilter 7, Sheets("Vervangen").Cells(2, 7)
    .Offset(1).EntireRow.Delete
    .AutoFilter
End With
End Sub
 
Volgens mijn glazenbol zou zoiets ook kunnen:

Code: 
Sub VenA()
  Sheets("Uren").Columns(7).Replace Sheets("Vervangen").[G2].Value, ""
  Sheets("Uren").Columns(7).SpecialCells(4).EntireRow.Delete
End Sub
 
Dank allen, ik heb de eerste oplossing getest en die werkte.

Echter, duurde het verwerken van deze bewerking van de data door Excel zo lang dat ik uiteindelijk voor een andere oplossing ben gegaan.

In het kort: ik filter nu op de gespecificeerde waarde op tabblad "vervangen" en verwijder niet de regels, maar alleen de inhoud.
Vervolgens zet ik de regels die nog inhoud hebben weer netjes op volgorde en heb ik hetzelfde resultaat, wat een stuk sneller gaat.

Code: 
 Sub Verwijderen_BewPlaatsen()

    Dim lNoOfRecords As Double
    Dim lNoToErase
    Dim FoundCell As Range
    Dim Criteria As String
  
    'Aantal rijen vinden op blad "Uren"
    lNoOfRecords = Application.CountIf(Sheets("Uren").Columns(1), "<>") + 1
    
    'Aantal te verwijderen bewerkingsplaatsen
    lNoToErase = Application.CountIf(Sheets("Aanpassen").Columns(7), "<>")
    
    'Gespecificeerde bewerkingsplaatsen verwijderen uit tabblad "Uren"
    For i = 2 To lNoToErase
    
        Criteria = Sheets("Aanpassen").Cells(i, 7)
        Sheets("Uren").Select
        Sheets("Uren").Range(Cells(2, 1), Cells(lNoOfRecords, 21)).AutoFilter Field:=7, Criteria1:=Criteria
    
        Set FoundCell = Sheets("Uren").Range(Cells(2, 1), Cells(lNoOfRecords, 21)).Find(What:=Criteria)
        If Not FoundCell Is Nothing Then
            Rows(FoundCell.Row & ":" & FoundCell.Row).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.ClearContents
            Sheets("uren").Range(Cells(2, 1), Cells(lNoOfRecords, 21)).AutoFilter Field:=7
            MsgBox (FoundCell.Row)
        Else
            MsgBox ("Machine nr " & Criteria & " is not found")
            Sheets("Uren").Range(Cells(2, 1), Cells(lNoOfRecords, 21)).AutoFilter Field:=7
        End If
    
    Next i
    
    'Tabblad "Uren" sorteren op kolom A
    
    ActiveWorkbook.Worksheets("Uren").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Uren").AutoFilter.Sort.SortFields.Add2 Key:=Range("A2:A50332"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        With ActiveWorkbook.Worksheets("Uren").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
    'Nieuw aantal rijen vinden
    lNoOfRecords = Application.CountIf(Sheets("Uren").Columns(1), "<>") + 1
    
    'Volgorde nummers (kolom A) opnieuw doornummeren
    Range(Cells(3, 1), Cells(4, 1)).Select
    Selection.AutoFill Destination:=Range(Cells(3, 1), Cells(lNoOfRecords, 1))

End Sub
 
iets van 34 regels code nodig met allerlei vertragende elementen en het gaat sneller? Lijkt mij onwaarschijnlijk. Eerst leegmaken dan sorteren zal mogelijk wel sneller zijn. Maar daar zijn echt niet zoveel regels code voor nodig.

Plaats het bestand zonder gevoelige data eens.
 
Hi VenA,

ik geloof je meteen. Dit is mijn eerste ervaring met VBA. De code heb ik geschreven door een beetje links en rechts te googlen en dit samen te voegen. :d

Hoor het graag wat er beter kan, en ook hoe of waarom!
 
Probeer het zo eens

Code: 
Sub VenA()
  Dim ar
  With Sheets("Aanpassen").Columns(7)
    If .SpecialCells(2).Count < 3 Then ar = .Cells(2, 1) Else ar = Split(Join(Application.Transpose(.SpecialCells(2).Offset(1).SpecialCells(2)), "|"), "|")
  End With
  If IsEmpty(ar) Then Exit Sub
  With Sheets("Uren").Cells(2, 1).CurrentRegion.Offset(1)
    .AutoFilter 7, ar, xlFilterValues
    On Error Resume Next
    .Offset(1).SpecialCells(12).ClearContents
    .AutoFilter 7
    .Sort .Cells(1), , , , , , , xlYes
    .Parent.Range("A3:A" & .Parent.Cells(Rows.Count, 1).End(xlUp).Row).Name = "temp"
    [temp] = [Row(temp)-2]
  End With
End Sub
 
Waarom zou je sorteren op kolom A?

edit: delete is te traag bemerk ik.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan