Inhoud cel verwijderen bij opeenvolgende cijfers.

[danny147]

Beste,

Ik heb 5245786 cellen die gevuld zijn met Lottocijfers in Excel 2007
Is niet mogelijk in Excel 2003.
Het bereik is A1:BU749398.

=COMBINATIES(42;6)

Als het kan wil ik 2 codes die:

1. Een code wanneer de inhoud van een cel 2 opeenvolgende cijfers heeft, dan de inhoud van de cel verwijderen.

2. Een code wanneer de inhoud van een cel 3 opeenvolgende cijfers heeft, dan de inhoud van de cel verwijderen.

Alle hebben ; tussen alle cijfers.
Vb. 1;2;3;4;5;6
De ; zou ik wel kunnen vervangen door een spatie als dit gemakkelijker is voor de code.

Nog een voorbeeldje voor alle duidelijkheid.

Groetjes Danny. :thumb:

 

[Ginger]

Danny, Waarom moet er nog gezocht worden naar 3 opeenvolgenden als die er bij 2 al wordt verwijderd?
Je zou het 'ns kunnen proberen met deze lus, maar ik vrees wel dat je tegelijk (maar dat vind jij als Belg vast niet erg) naar het naburige café kan lopen voor een pintje...

Sub DoeWat()

    For Each c In Selection
        For i = 0 To 4
            element = Split(c.Value, ";")
            If (element(i + 1)) - element(i) = 1 Then
                c.Value = ""
                Exit For
            End If
        Next i
    Next c

End Sub

Selecteer de cellen waarvoor dit moet gelden en laat de code lopen (doe dit aub ECHT wel ff op een kopie voordat je al je 'zoveel honderdduizend strings' kwijt bent).

Groet, Leo

 

[danny147]

Beste Ginger

Waarom moet er nog gezocht worden naar 3 opeenvolgenden als die er bij 2 al wordt verwijderd?

Ik wil het verschil in combinaties zien bij 2 of 3 opeenvolgende nummers.

Krijg 3 foutmeldingen bij de volgende:

c is niet gedefinieerd (Range ?)
i is niet gedefinieerd (Variant ?)
element is niet gedefinieerd ( ???)

Als ik de code laat lopen zal ik kolom per kolom uit proberen of ik geraak niet meer uit de café

Groetjes Danny. :thumb:

 

[Jack Nouws]

Krijg 3 foutmeldingen bij de volgende:

c is niet gedefinieerd (Range ?)
i is niet gedefinieerd (Variant ?)
element is niet gedefinieerd ( ???)

Groetjes Danny. :thumb:

Misschien dat dit wil helpen om de code verder te laten lopen.
Bij mij loopt tie als een zonnetje. :thumb:
(wel het bereik selecteren) :thumb:

Sub DoeWat()

    For Each c In Selection
        For i = 0 To 4
           element = Split(c.Value, ";")
            [COLOR="Red"]On Error Resume Next[/COLOR]
             If (element(i + 1)) - element(i) = 1 Then
                c.Value = ""
                Exit For
            End If
        Next i
    Next c

End Sub

Met vr gr
Jack

 

[Ginger]

Ik wil het verschil in combinaties zien bij 2 of 3 opeenvolgende nummers.

OK, maar dan heb je nu die van '2'. Die voor 3 moet ik nog ff bedenken...

Krijg 3 foutmeldingen bij de volgende:

Jij begint waarschijnlijk al je modules met 'Option Explicit'. Ik heb inderdaad niet gedeclareerd, dus dan krijg je foutmeldingen. Haal dus óf ff die OE weg bovenaan, óf declareer de 3 gebruikte variabelen.
Dim c as Range
Dim i as Integer
Dim element as Variant

Groet, Leo

 

[Ginger]

Misschien dat dit wil helpen om de code verder te laten lopen.

Jack, wees zéér zuinig met het gebruik van de 'On Error Resume Next'. Beter is het om te kijken waardoor de fout écht ontstaat. Met de 'resume next' buig je alles recht dat krom is.

Groet, Leo

 

[Wigi]

In ieder geval is de volgorde van

For i = 0 To 4
element = Split(c.Value, ";")

fout. Die moet omgekeerd worden.

 

[Jack Nouws]

Jack, wees zéér zuinig met het gebruik van de 'On Error Resume Next'. Beter is het om te kijken waardoor de fout écht ontstaat. Met de 'resume next' buig je alles recht dat krom is.

Groet, Leo

Sorry het was maar een tip.

met vr gr
Jack

 

[danny147]

Beste Ginger

Nu gaat ie lekker.

Voor 1000 rijen doet hij er 1 min. over

En ik heb een rij staan van 749398 cellen, DUS 749 min. = 12uur en 30 min.

Tegen dat ik terug kom van het café ben ik al goe zat

Groetjes Danny. :thumb:

 

[Wigi]

Keer het probleem om.

Sub verwijderopeenvolgenden()

    For i = 1 To 42
    
        Set rng = Cells.Find(What:=i & ";" & i + 1, LookIn:=xlValues, lookat:=xlPart)
        
        If Not rng Is Nothing Then
            strAddress = rng.Address
            Do
                rng.ClearContents
                Set rng = Cells.FindNext(rng)
                If rng Is Nothing Then Exit Do
            Loop Until rng.Address = strAddress
        End If
    Next
    
End Sub

Wigi

 

[Ginger]

Sorry het was maar een tip.

Jack, dat wéét ik! Vandaar dat ik jou óók weer ff een tip geef.
Ik weet dat je heel enthousiast het programmeren onder de knie probeert te krijgen, vandaar dat het goed is als je voor dit soort valkuilen wordt gewaarschuwd. Het 'on error' gebruik je eigenlijk alleen maar (en dat is dus mijn mening) als je een fout van de gebruiker verwacht die je echt niet anders kan opvangen óf dat je JUIST gebruik wilt maken van het feit dat er een fout ontstaat. In ieder ander geval zorg je dat je programma zo in elkaar steekt dat je 'de gebruiker een stapje voor bent'.

Een foutafhandeling in je code is natuurlijk wel altijd goed. Zeker als het om grote programma's gaat is het zelfs een must. Je wilt namelijk dan afvangen dat een gebruiker met de Debug-melding voor z'n neus zit.

Groet, Leo

 

[Ginger]

Keer het probleem om.
Wigi

Óók een mooie insteek!!!

Groet, Leo

 

[snb]

of ?

Sub tst()
  With ThisWorkbook.Sheets(1).Range("C8:C16")
    For j = 1 To 98
      .Replace j & ";" & j + 1, "x"
    Next
    .AutoFilter , "<>*x*"
  End With
End Sub

 

[Wigi]

Kan ook Snb, alleen bestaat het bereik uit vele kolommen, en niet 1 kolom.

 

[snb]

Als snelheid van belang is:

Sub tst()
  With ThisWorkbook
    .Sheets(1).Cells.Replace ";", "|"
    .SaveAs "E:\OF\opeenvolgend.csv", xlCSV
  End With
  With CreateObject("scripting.filesystemobject").opentextfile("E:\OF\opeenvolgens.csv")
    c0 = .readall
    .Close
  End With
  For j = 1 To 42
    c0 = Replace(c0, j & "|" & j + 1, "x")
  Next
  With CreateObject("scripting.filesystemobject").createtextfile("E:\OF\opeenvolgend 001.csv")
    .Write c0
    .Close
  End With
  Workbooks.Open "E:\OF\opeenvolgend 001.csv"
  ActiveWorkbook.Sheets(1).Cells.Replace "*x*", ""
End Sub

 

[Ginger]

Allen, ik zat eigenlijk te denken aan de onzin waar we mee bezig zijn. Waarom eerst de complete tabel genereren om DAARNA de niet gewenste elementen te verwijderen. Dan is het toch beter om gewoon een nieuwe tabel aan te maken met de gewenste spronggrootte?
Ik had zoiets bedacht maar dat is natuurlijk retetraag...

Sub GenereerLottoSpeciaal()
Dim i As Long
Dim j As Integer
Const WAARDE As Integer = 2

    j = 1
    application.screenupdating = false
    For a = 1 To 37
        For b = a + WAARDE To 38
            For c = b + WAARDE To 39
                For d = c + WAARDE To 40
                    For e = d + WAARDE To 41
                        For f = e + WAARDE To 42
                            i = i + 1
                            Cells(i, j).Value = a & "; " & b & "; " & c & "; " & d & "; " & e & "; " & f
                            If i = 65536 Then '65536
                                i = 0
                                j = j + 1
                                If j = 10 Then Exit Sub
                            End If
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    application.screenupdating = true
End Sub

Beter is het om eea naar een variant te halen en van daaruit te gaan werken en vervolgens in 1 klap weg te schrijven naar de sheet (ipv mijn cel-voor-cel lus). In mijn voorbeeld heb ik ff de kolommen op 10 gehouden om niet te lang te moeten wachten op resultaat. Ik denk zo dat de 'groten' onder ons dit een stuk beter af kunnen handelen...

Groet, Leo

 

[danny147]

Beste Ginger, Wigi, snb en Jack Nouws

Aangezien de codes allemaal veel te lang duren, heb ik het volgende gedaan.
Achter elke kolom heb ik een formule geschreven die mij als uitkomst 1 geeft als er 2 opeenvolgende getallen zijn.

Nu zou ik graag een code willen die de inhoud van de cellen verwijderd, als er in de volgende (naastliggende kolom) kolom een 1 staat.

Zou daarmee de snelheid vermeerderen ?
De code moet dan maar naar 1 cijfer zoeken ipv een reeks cijfers te ontcijferen.

Zie bijgaand bestandje.

Groetjes Danny. :thumb:

 

[Wigi]

Sorteer de 2 kolommen, en dan heb je ze direct.

 

[trucker10]

@ Danny , kan je het hier mee ?

Sub tst()
    Set rng = Range("C4:C8") ' range aan te passen 
    For Each Cell In rng
    If Cell.Value = "1" Then
    Cell.Offset(, -1).Value = ""
    Cell.Value = ""
    End If
    Next Cell
End Sub

Ik had nog net de tijd om dit ook nog mee te geven het werkt ook over meerdere kolommen zie (2)
Danny ik heb nogmaals het bestandje gewisseld heb er een

Sub tst()
    Set rng = ActiveSheet.UsedRange
    For Each Cell In rng
    If Cell.Value = "1" Then
    Cell.Offset(, -1).Value = ""
    Cell.Value = ""
    End If
    Next Cell
End Sub

van gemaakt

 

[danny147]

Beste Wigi en trucker10

2 vliegen in 1 klap.

Eerst de kolommen sorteren op waardes van klein naar groot. (Antwoord Wigi) :thumb:

Dan de code laten lopen (Antwoord trucker10) :thumb:

Zal nog een tijdje duren voor alleer de formules allemaal geplaats zijn achter de lottocijfers.
Dan allemaal sorteren van klein naar groot en tenslotte de code laten lopen om het overbodige te laten wissen.
Als alles achter de hand is, dan zal ik eens uitleggen wat de bedoeling hier allemaal van is.

VOORDEEL !

Mijn behoude waardes staan allemaal netjes bovenaan gerangschikt, anders staan er nog lege cellen tussen.

Nog een vraagje, kan je de volgende code aanpassen zodat de code het bereik zoekt die ik intyp in cel A1.

Sub tst()
    Set rng = Range("C4:C8") ' [B][COLOR="Red"]Dit bereik staat in cel A1[/COLOR][/B]
    For Each Cell In rng
    If Cell.Value = "1" Then
    Cell.Offset(, -1).Value = ""
    Cell.Value = ""
    End If
    Next Cell
End Sub

Groetjes Danny. :thumb: