Farben & Buchstaben suchen & ersetzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Es ist Sonntag,... das habe ich übersehen :-(
Nun ja,... dann mal eine Quick-und-Dirty Lösung
Beim Start des Makros muss die Tabelle aktiv sein, wo die Suchbegriffe sind.
Option Explicit

Sub Replace_Text()
    Dim srcString As String, repString As String
    Dim repCol As Integer, srcCol As Integer, i As Integer
    Dim myC As Range
    Dim qWks As Worksheet
    Set qWks = Worksheets(ActiveSheet.Name)
    srcString = InputBox("Was soll ersetzt werden?", "Suche nach...", "")
    repString = InputBox("Durch was soll: "" " & srcString & " "" ersetzt werden ?", "Ersetzen mit...", "")
    If srcString = "" Or repString = "" Then
        MsgBox "Vorgang kann nicht durchgeführt werden"
        Set qWks = Nothing
        Exit Sub
    End If
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    With ActiveSheet
        .Name = "TempColorDef"
        For i = 1 To 56
            .Cells(i, 1).Interior.ColorIndex = i
            .Cells(i, 2) = i
        Next i
    End With
    srcCol = InputBox("Welche Schriftfarbe hat der Suchbegriff "" " & srcString & " ""?" & vbCrLf & "0 = Keine Suchfarbe", "Farben Definition", "Farbnummer eingeben")
    repCol = InputBox("Welche Farbe soll für den Ersetzungsbegriff "" " & repString & " "" verwendet werden ?" & vbCrLf & "0 = Keine Suchfarbe", "Farben Definition", "Farbnummer eingeben")
    If Not IsNumeric(repCol) Then
        MsgBox "Keine Farbnummer definiert"
        Exit Sub
    End If
    Application.DisplayAlerts = False
    Worksheets("TempColorDef").Delete
    Application.DisplayAlerts = False
    qWks.Select
    For Each myC In ActiveSheet.UsedRange
        If srcCol <> 0 Then
            If myC.Value = srcString And myC.Font.ColorIndex = srcCol Then
                myC.Value = repString
                If repCol <> 0 Then
                    myC.Font.ColorIndex = repCol
                End If
            End If
        Else
            If myC.Value = srcString Then
                myC.Value = repString
                If repCol <> 0 Then
                    myC.Font.ColorIndex = repCol
                End If
            End If
        End If
    Next myC
    Set qWks = Nothing
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Farben & Buchstaben suchen & ersetzen

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Farben & Buchstaben suchen & ersetzen

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread