Zoeken en vervangen

[Noord2011]

Beste mensen,

Ik ben bezig met een automatische inhoud opgave voor mijn onderhoudsplan en ik wil dat niet alle sheet namen in de inhoud opgave komen te staan.

Wat ik wil is dat bijv: als in het column C (Range C6: C47) het tekst onderhoud 1, onderhoud 2 enz staan, dient deze teksten te vervangen worden tot een tekst “onderhouden”. En het hoogste blz nummering moet achter de tekst onderhouden komen te staan in column E.

Dus vervangen van het teksten onderhoud 1 t/m 7 door onderhouden met het blz nummer 11. En het onderhoud 1 t/m 7 teksten moet verwijderd worden. De onderstaande teksten moeten mee schuiven.

Voor een overzicht ziet sheet 1 en sheet 2
Alles moet gebeuren met het knop Update

Alvast bedankt

 

[Noord2011]

Ik heb voor me zelf wat codes aan elkaar geplakt, maar het functioneert nog niet goed.

Wat ik wil nu da het activecell en de twee rechter cellen worden gedetecteerd en verwijderd.

Tot nu toe wordt alleen het 2de rechter cell verwijderd.

Wie kan me verder helpen?
zie bijlage

 

[Noord2011]

Volgens mij ben ik nog een stap veder gekomen. Alleen moet nog de rode teksten verwijdert worden exclusief het onderhoud tekst met het hoogste cijfer (onderhoud 8) en vervolg voorzien van blz 5 en project 1 voorzien van blz 13.

Graag reageert met wat alles bij elkaar kan tot een oplossing komen!

 

[Warme bakkertje]

Test deze eens

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
cl = WorksheetFunction.CountIf([C6:C48], "Onderhoud " & "*") - 1
    With Sheets("Sheet1").Columns(3)
        .Find("Onderhoud " & "*", , xlValues, xlPart).Resize(cl).EntireRow.Delete xlUp
        Set c = .Replace(.Find("Onderhoud " & "*", , xlValues, xlPart), "Onderhouden")
    End With
Application.ScreenUpdating = True
End Sub

 

[Noord2011]

Het ziet goed uit, maar in column H tot en met P mag niks verwijder worden. In mijn originele excel doc staan daar meer gegevens.

Kan iemand me verder helpen?

Warme bakkertje heel erg bedankt!!!!

 

[Warme bakkertje]

Deze had je toch zelf wel kunnen vinden, denk ik

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
cl = WorksheetFunction.CountIf([C6:C48], "Onderhoud " & "*") - 1
    With Sheets("Sheet1").Columns(3)
        .Find("Onderhoud " & "*", , xlValues, xlPart).Resize(cl, 3).ClearContents
        Set c = .Replace(.Find("Onderhoud " & "*", , xlValues, xlPart), "Onderhouden")
    End With
Application.ScreenUpdating = True
End Sub

 

[Noord2011]

Tja, je had gelijk niet goed na gedacht.

Maar nu kom ik achter dat het tekst "onderhouden krijgt de hoogte blz nummer. Is het niet mogelijk dat het kleinste nummer krijgt en of de kleinste en de hoogste in dezelfde cell.

bijv1 het kleinste blz nummer 5
bijv2 het kleinste en het grootste blz nummer 5 t/m 18

Alvast bedankt

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
cl = WorksheetFunction.CountIf([C6:C48], "Onderhoud " & "*") - 1
    With Sheets("Sheet1").Columns(3)
        .Find("Onderhoud " & "*", , xlValues, xlPart).Resize(cl, 3).Delete xlUp  '.ClearContents
        Set c = .Replace(.Find("Onderhoud " & "*", , xlValues, xlPart), "Onderhouden")
    End With
Application.ScreenUpdating = True
End Sub

 

[Warme bakkertje]

Voor het kleinst nr kan je dit gebruiken

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
    With Sheets("Sheet1").Columns(3)
        Set c = .Replace(.Find("Onderhoud " & "*", , xlValues, xlPart), "Onderhouden")
        cl = WorksheetFunction.CountIf([C6:C48], "Onderhoud " & "*")
        .Find("Onderhoud " & "*", , xlValues, xlPart).Resize(cl, 3).ClearContents
    End With
Application.ScreenUpdating = True
End Sub

Je vb2 zal ik later op de dag eens bekijken

 

[Noord2011]

Het gaat de goede kant op, met maximaal tekst onderhoud 9. Bij tekst onderhoud 11 t/m 20 gaat het niet goed!

Hoe kan dit opgelost worden. In mijn vraag was het t/m tekst onderhoud 9 maar het wordt uitgebreid tot tekst onderhoud 25. SORRY!!!

 

[Warme bakkertje]

Test

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
On Error Resume Next
    With Sheets("Sheet1").Columns(3)
        cl = WorksheetFunction.CountIf([C6:C48], "Onderhoud " & "**")
        cl2 = .Find("Onderhoud " & "**", , xlValues, xlPart).Offset(cl - 1, 2).Value
        Set c = .Replace(.Find("Onderhoud " & "*", , xlValues, xlPart), "Onderhouden")
        .Find("Onderhouden", , xlValues, xlWhole).Offset(, 2).Value = .Find("Onderhouden", , xlValues, xlWhole).Offset(, 2).Value & " t/m " & cl2
        .Find("Onderhoud " & "**", , xlValues, xlPart).Resize(cl - 1, 3).ClearContents
    End With
Application.ScreenUpdating = True
End Sub

 

[Noord2011]

Precies wat ik zoek, heel erg bedankt :thumb: