via macro inhoud cellen samenvoegen en vervolgens verwijderen

[Delee]

Hi! Wie kan mij helpen?
Ik heb een logfile uit een telefooncentrale.
Op sommige regels, afhankelijk van de inhoud van een cel, moet de inhoud van 3 cellen worden samengevoegd en de rest van die rij 2 cellen naar links worden verplaatst.
In mijn bijgevoegd voorbeeld: vanwege de inhoud van cel F32 moeten de cellen F32 t/m H32 worden samengevoegd en daarna moeten de cellen G32 en H32 worden verwijderd en de rest van de rij moet naar links worden opgeschoven.
en dat dan voor meerdere rijen, afhankelijk van cel F32

 

[wampier]

Er is mogelijk wel iets aan te doen als er een manier is de uitzonderingen te herkennen. De file bevat echter persoonlijke informatie. Die kun je beter even verwijderen en een opgeschoond voorbeeld inclusief de manier om een "foute" regel te vinden weer terug plaatsen.

Alle foute lijnen beginnen met "!$" ? of zijn er uitzonderingen?

 

[Delee]

Alle foute lijnen beginnen met "!$" !
!$Queued is 3cellen in 1cel en dan 2cellen verwijderen (in resp. kolom FGH en IJK)
!$StillQueued is 2cellen in 1cel en 1cel verwijderen (in resp. FG en HI)

=> dan komen dezelfde waardes keurig onder elkaar.

 

[wampier]

Probeer het eens met deze code:

Sub zoeken_en_vervangen()

Set waar = ActiveSheet.Cells.Find("!$", , , xlPart)
If Not waar Is Nothing Then
    beginwaarde = waar.Address
    Do
        If LCase(Left(waar.Value, 5)) = "!$que" Then
            waar.Value = waar.Value & " " & waar.Offset(0, 1).Value & " " & waar.Offset(0, 2).Value
            Range(waar.Offset(0, 1), waar.Offset(0, 2)).Delete (xlShiftToLeft)
        End If
        If LCase(Left(waar.Value, 5)) = "!$sti" Then
            waar.Value = waar.Value & " " & waar.Offset(0, 1).Value
            waar.Offset(0, 1).Delete (xlShiftToLeft)
        End If
        
        Set waar = ActiveSheet.Cells.FindNext(waar)
    Loop While Not waar Is Nothing And waar.Address <> beginwaarde
End If

End Sub

 

[Delee]

Hij doet het fantastisch! Wat een prachtige code, complimenten. Vind je het gek dat ik daar niet op kwam...
Heb ik 1 laatste vraagje (dat krijg je als je zo goed bent als jij):

Als je de macro een tweede keer afstart (bijvoorbeeld omdat je loggegevens hebt toegevoegd) dan doet ie eigenlijk iets teveel, namelijk de regels die ie al gedaan heeft opnieuw.
Zouden we (- jij? een voorwaarde in kunnen bakken dat wanneer 2 cellen naast elkaar allebei beginnen met !$ dat ie dan bovenstaande procedure niet hoeft uit te voeren op die regel.
Alleen als het erg makkelijk is hoor, anders pas ik mij wel aan.

 

[wampier]

Moet de !$ bewaard blijven? Anders kun je na de eerste pass bijvoorbeeld het uitroepteken weghalen en dan wordt hij bij een volgende pass niet meer meegenomen.

 

[Delee]

da's ook een goed idee! Help je me daar mee? ajb.

 

[wampier]

zoiets:

Sub zoeken_en_vervangen()

Set waar = ActiveSheet.Cells.Find("$", , , xlPart)
If Not waar Is Nothing Then
    beginwaarde = waar.Address
    Do
        If LCase(Left(waar.Value, 5)) = "!$que" Then
            waar.Value = Right(waar.Value, Len(waar.Value) - 1) & " " & waar.Offset(0, 1).Value & " " & waar.Offset(0, 2).Value
            Range(waar.Offset(0, 1), waar.Offset(0, 2)).Delete (xlShiftToLeft)
        End If
        If LCase(Left(waar.Value, 5)) = "!$sti" Then
            waar.Value = Right(waar.Value, Len(waar.Value) - 1) & " " & waar.Offset(0, 1).Value
            waar.Offset(0, 1).Delete (xlShiftToLeft)
        End If
        
        Set waar = ActiveSheet.Cells.FindNext(waar)
    Loop While Not waar Is Nothing And waar.Address <> beginwaarde
End If

End Sub

 

[Delee]

Wampier, het is niet te geloven, waanzinnig en zo snel. Wat een code man. Chapeau! Mijn dank is heel groot.

Ik zal mijn vraag op 'opgelost' zetten. Nogmaals heel hartelijk dank.