Inhalt mit Color index 40 Löschen

dennis · 2020-01-06T16:03:59+00:00

Hallo Zusammen Ich habe Vor bei einer Riesigen Datei den Inhalt aller Felder mit der FarbFormatierung colorindex 40 (Hintergrundfarbe) zu Löschen und die Formatierung Beizubehalten. Ich möchte auch Vorher Gefragt werden ob Wirklich alles Gelöscht werden soll Wenn ja dann Löschen wenn nein dann End Sub. Kann mir hier Jemand Helfen ?

Hallo Dennis,
verbundene Zellen machen immer Probleme. Zum Teufel mit dem Microsoftprogrammierer dem das eingefallen ist.
Teste das mal:

Option Explicit

Public Sub Test()
    Dim objCell As Range
    If MsgBox("Wirklich löschen?", vbQuestion Or vbYesNo, "Abfrage") = vbYes Then
        Application.ScreenUpdating = False
        With Application.FindFormat
            Call .Clear
            .Interior.ColorIndex = 40
        End With
        Set objCell = Cells.Find(What:="*", LookAt:=xlPart, SearchFormat:=True)
        If Not objCell Is Nothing Then
            Do
                If objCell.MergeCells Then
                    Call objCell.MergeArea.ClearContents
                Else
                    Call objCell.ClearContents
                End If
                Set objCell = Cells.Find(What:="*", LookAt:=xlPart, SearchFormat:=True)
            Loop Until objCell Is Nothing
        End If
        Application.ScreenUpdating = True
    End If
End Sub

Gruß
Nepumuk

Hallo Dennis,
das ist nicht normal. Ist es so schneller?

Option Explicit

Public Sub Test()
    Dim objCell As Range
    If MsgBox("Wirklich löschen?", vbQuestion Or vbYesNo, "Abfrage") = vbYes Then
        With Application
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        With Application.FindFormat
            Call .Clear
            .Interior.ColorIndex = 40
        End With
        Set objCell = Cells.Find(What:="*", LookAt:=xlPart, SearchFormat:=True)
        If Not objCell Is Nothing Then
            Do
                If objCell.MergeCells Then
                    Call objCell.MergeArea.ClearContents
                Else
                    Call objCell.ClearContents
                End If
                Set objCell = Cells.Find(What:="*", LookAt:=xlPart, SearchFormat:=True)
            Loop Until objCell Is Nothing
        End If
        With Application
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub

Gruß
Nepumuk

Inhalt mit Color index 40 Löschen

Forumthread: Inhalt mit Color index 40 Löschen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Inhalt mit Color index 40 Löschen

Forumthread: Inhalt mit Color index 40 Löschen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread