Foutmelding waarschijnlijjk code regel te lang ?

Status
Niet open voor verdere reacties.

vhenk

Gebruiker
Lid geworden
4 feb 2009
Berichten
33
Hoi allemaal,

Ik heb een code waar bepaalde rijen met aan de hand van een if functie verwijder worden.
Nu heb ik dat er ongeveer 600 uitzonderingen zijn die ik eigenlijk via vba wil regelen.
Als ik de uitzonderingen in de code zet geef hij een foutmelding.
Waarschijnlijk dat de formule te lang is .

Wie kan en wil mij daar bij helpen

groet henk


Code:
Sub Rijen_verwijderen()
Application.ScreenUpdating = False
    Dim lRij As Long
    
    For l = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        
        If Range("A" & l).Value = "" Or Left(Range("A" & l).Value, 1) = "-" Then
Range("A" & l).Value = "** Value 10402 ca" Or Range("A" & l).Value = "** Value 10401 ca" Or Range("A" & l).Value = "** Value 10400 ca" Or Range("A" & l).Value = "** Value 10399 ca" Or Range("A" & l).Value = "** Value 10398 ca" Or Range("A" & l).Value = "** Value 10397 ca" Or Range("A" & l).Value = "** Value 10396 ca" Or Range("A" & l).Value = "** Value 10395 ca" Or Range("A" & l).Value = "** Value 10394 ca" Or Range("A" & l).Value = "** Value 10393 ca" Or Range("A" & l).Value = "** Value 10392 ca" Or Range("A" & l).Value = "** Value 10391 ca" Or Range("A" & l).Value = "** Value 10390 ca" Or Range("A" & l).Value = "** Value 10389 ca" Or Range("A" & l).Value = "** Value 10388 ca" Or Range("A" & l).Value = "** Value 10387 ca" Or Range("A" & l).Value = "** Value 10386 ca" Or Range("A" & l).Value = "** Value 10385 ca" Or Range("A" & l).Value = "** Value 10384 ca" Or Range("A" & l).Value = "** Value 10383 ca" Or Range("A" & l).Value = "** Value 10382 ca" Or Range("A" & l).Value = "** Value 10
381 ca" Or Range("A" & l).Value = "** Value 10380 ca" Or Range("A" & l).Value = "** Value 10379 ca" Or Range("A" & l).Value = "** Value 10378 ca" Or Range("A" & l).Value = "** Value 10377 ca" Or Range("A" & l).Value = "** Value 10376 ca" Or Range("A" & l).Value = "** Value 10375 ca" Or Range("A" & l).Value = "** Value 10374 ca" Or Range("A" & l).Value = "** Value 10373 ca" Or Range("A" & l).Value = "** Value 10372 ca" Or Range("A" & l).Value = "** Value 10371 ca" Or Range("A" & l).Value = "** Value 10370 ca" Or Range("A" & l).Value = "** Value 10369 ca" Or Range("A" & l).Value = "** Value 10368 ca" Or Range("A" & l).Value = "** Value 10367 ca" Or Range("A" & l).Value = "** Value 10366 ca" Or Range("A" & l).Value = "** Value 10365 ca" Or Range("A" & l).Value = "** Value 10364 ca" Or Range("A" & l).Value = "** Value 10363 ca" Or Range("A" & l).Value = "** Value 10362 ca" Or Range("A" & l).Value = "** Value 10361 ca" Or Range("A" & l).Value = "** Value 10360 ca" Or Range("A" & l).Value = "
** Value 10359 ca" Or Range("A" & l).Value = "** Value 10358 ca" Or Range("A" & l).Value = "** Value 10357 ca" Or Range("A" & l).Value = "** Value 10356 ca" Or Range("A" & l).Value = "** Value 10355 ca" Or Range("A" & l).Value = "** Value 10354 ca" Or Range("A" & l).Value = "** Value 10353 ca" Or Range("A" & l).Value = "** Value 10352 ca" Or Range("A" & l).Value = "** Value 10351 ca" Or Range("A" & l).Value = "** Value 10350 ca" Or Range("A" & l).Value = "** Value 10349 ca" Or Range("A" & l).Value = "** Value 10348 ca" Or Range("A" & l).Value = "** Value 10347 ca" Or Range("A" & l).Value = "** Value 10346 ca" Or Range("A" & l).Value = "** Value 10345 ca" Or Range("A" & l).Value = "** Value 10344 ca" Or Range("A" & l).Value = "** Value 10343 ca" Or Range("A" & l).Value = "** Value 10342 ca" Or Range("A" & l).Value = "** Value 10341 ca" Or Range("A" & l).Value = "** Value 10340 ca" Or Range("A" & l).Value = "** Value 10339 ca" Or Range("A" & l).Value = "** Value 10338 ca" Or Range("A" & l)
.Value = "** Value 10337 ca" Or Range("A" & l).Value = "** Value 10336 ca" Or Range("A" & l).Value = "** Value 10335 ca" Or Range("A" & l).Value = "** Value 10334 ca" Or Range("A" & l).Value = "** Value 10333 ca" Or Range("A" & l).Value = "** Value 10332 ca" Or Range("A" & l).Value = "** Value 10331 ca" Or Left(Range("A" & l).Value, 1) = "-" Then
        
            Rows(l).Delete
        
        End If
    
    Next
    
    Application.ScreenUpdating = True

End Sub
 
Code:
Sub Rijen_verwijderen()
  Application.ScreenUpdating = False
  On Error Resume Next
    
  For j = 10331 To 10402
    Columns(1).Replace "**Value " & j & " ca", ""
  Next
  Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

  Do
    If Left(Columns(1).Find("-", , xlValues), 1) = "-" Then Columns(1).Find("-", , xlValues).EntireRow.Delete
  Loop Until Err.Number > 0

  Application.ScreenUpdating = True
End Sub
 
Nu verwijderd hij alles

Hoi, bedankt voor het meedenken.
Enkel het is een bestand met ruim 650.000 regels, nu heeft hij met deze code echt alles gewist.
Dus helaas niet de oplossing voor min probeleem.
Als iemand een suggestie heeft graag.

Henk :confused:
 
Dan denk ik dat in je vraag iets niet klopt.
Zet hier dan een eens een deel van het bestand met regels die wel en die niet gewist moeten worden.
 
Klein voorbeeldje bijgesloten

Ik heb het bestand even in het klein nagebootst.
In het voorbeeld zie je mijn bedoeling
Regels die verwijderd moeten worden:
regel 1, 8,10,11,12, 22, 23,24,25,26,33,34,35,36,37

Zoals eerder gezegd die ik de uitzonderingen er uit te halen.
In het script wat ook is bijgesloten, is gebasseerd op mijn grote bestand war de velden net even iets anders staan als in mijn voorbeeld.
Als jullie mij op weg willen helpen dan kan ik de aanpassingen wel doorvoeren op mijn orginele scheet.
Alvast bedankt en ik hoop dat je wat heb aan het voor beeld wat ik mee stuur

Henk
 

Bijlagen

Code:
Sub regelsweg()
  With Sheets("Voorraadartikel").Columns(2)
    .Replace ".", ""
    .Replace "-", ""
    x = .SpecialCells(xlCellTypeBlanks).Areas.Count
    For j = 1 To x
      .SpecialCells(xlCellTypeBlanks).Areas(1).EntireRow.Delete
    Next
  End With
End Sub
 
Code geprobeerd

Beste SNB

Ik heb de code geprobeerd op nu zo`n 65000 regels, en hij is lekker aan het rekenen geweest. Met als uitkomst dat de overtollige regels zijn weggehaald.
Bedankt hier voor waanzinnig dat het gelukt is.

Ik kan alleen de code niet goed begrijpen.

Code:
Sub regelsweg()
  With Sheets("Voorraadartikel").Columns(2)
'Hieronder wordt de punt omgezet naar niks
    .Replace ".", ""
'Hieronder wordt het - omgezet naar niks
    .Replace "-", ""
'hieronder gaat het mij een pet te ver
    x = .SpecialCells(xlCellTypeBlanks).Areas.Count
    For j = 1 To x
      .SpecialCells(xlCellTypeBlanks).Areas(1).EntireRow.Delete
    Next
  End With
End Sub

Kan jij een korte uitleg over de code geven om hem beter te begrijpen , want ik wil hier graag van leren.

Nogmaals bedankt.

Henk :thumb:
 
1. maak in kolom B alle cellen met een punt (.) leeg
2. maak in kolom B alle cellen met een verbindignsstreepje (-) leeg
3. tel in kolom B het aantal gebieden van aaneengesloten lege (xlcelltypeblanks) cellen
NB om te kijken welke cellen dat zijn kun je voor de regel x=...
de regel .specialcells(xlcelltypeblanks).select zetten, dan kun je zien welke cellen in kolom B leeg zijn. Ieder groepje van gemarkeerde cellen is een gebied ('area')
4. verwijder alle regels van het eerste gebied (area) met lege cellen in kolom B
5. als hierna het eerste gebied met lege cellen in kolom B wordt bepaald is dat anders omdat hiervóór een gebied is verwijderd.

PS. het aardigste vind ik de vergeljiking tussen de oomvang van jouw code in je vraag en de oplossing: met hoe weinig code kun je iets voor elkaar krijgen.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan