VBA-Skript zum Füllen von Zellen, die beliebige Textzeichenfolgen enthalten

VBA-Skript zum Füllen von Zellen, die beliebige Textzeichenfolgen enthalten

Ich versuche, ein VBA-Skript zu erstellen, das einen Zellbereich, der eine beliebige Textzeichenfolge enthält, bedingt mit einer Füllfarbe meiner Wahl formatiert.

Bisher verwende ich eine Excel-Regel zur bedingten Formatierung, um dies zu erreichen, und es funktioniert. Das Ziehen und Ablegen des Zellinhalts von einer Spalte in eine andere führt jedoch dazu, dass die Regeln zur bedingten Formatierung sehr fragmentiert werden und schnell zu einem Durcheinander werden. Was als zwei Regeln zur bedingten Formatierung begann, eine für Spalte A und eine andere für Spalte B, wird schnell zu Dutzenden separater Regeln, da Excel das Feld „Gilt für“ der Regeln bei jedem Kopieren oder Verschieben von Zelldaten ändert.

Bildbeschreibung hier eingeben

Ein VBA-Skript, das dasselbe erreichen kann wie meine Regeln zur bedingten Formatierung, wäre viel besser, da es nicht durch das Verschieben oder Kopieren und Einfügen von Zelldaten beeinträchtigt würde. Ich könnte meine Daten frei per Drag & Drop in die entsprechende Spalte ziehen, ohne dass der zugrunde liegende VBA-Code beeinträchtigt würde.

Hat hier jemand mit grundlegender VBA-Codierungserfahrung eine Idee für einen einfachen Code, mit dem ich die Füllfarbe aller Zellen ändern könnte, die eine beliebige Zeichenfolge enthalten? Dies würde auf die Zellen A1:A200 zutreffen.

Wenn Ihnen aus irgendeinem Grund etwas an meiner Frage nicht gefällt, wie es David Postill kürzlich tat, teilen Sie mir dies bitte in einem Kommentar mit und geben Sie mir ein paar Minuten Zeit, ihn mit allen zusätzlichen Informationen zu aktualisieren, die Sie für notwendig erachten, anstatt ihn herunterzustimmen und zu verschwinden.

Ich bin nur an Rückmeldungen von Leuten mit grundlegender VBA-Erfahrung und dem Wunsch interessiert, hilfreich zu sein. Bitte keine schnippischen Kommentare wie „Wir werden nicht irgendein Skript, das Sie online gefunden haben, für Sie debuggen.“ Ich möchte nur von positiven, HILFREICHEN Leuten hören.

Antwort1

Es ist ärgerlich, dass die bedingte Formatierung fragmentiert werden kann, wie Sie beschrieben haben. Ich versuche, bedingte Formatierungsregeln zu schreiben, die für eine ganze Spalte oder ganze Spalten gelten. Dann kann ich eine fragmentierte Adresse wie „ $B$24,$B$25:$C$25,$B$27:$C$1048576,$B$26,$B$21:$C$23,$B$1:$C$19,$B$20zurück in“ ändern $B:$C.

Da Sie mich an dieses Ärgernis erinnert haben, habe ich ein Makro geschrieben, um fragmentierte Adressen in bedingten Formatierungsregeln zu korrigieren. Das Makro hilft nur, wenn die bedingten Formatierungsregeln auf eine ganze Spalte oder mehrere Spalten angewendet werden.

Sub ApplyConditionalFormattingToEntireColumns()
    Dim oneFormatCondition As FormatCondition
    Dim strAddresses() As String, lngA As Long
    Dim strFirst As String, strLast As String, strCheck As String

    For Each oneFormatCondition In ActiveSheet.Cells.FormatConditions
        strFirst = ""
        strLast = ""
        'Splits each condition's addresses into an array.
        strAddresses = Split(oneFormatCondition.AppliesTo.Address, ",")
        For lngA = LBound(strAddresses) To UBound(strAddresses)
            'Finds and saves the first column.
            strCheck = strAddresses(lngA)
            strCheck = Mid(strCheck, 2, _
                InStr(2, strCheck, "$", vbTextCompare) - 2)
            If strFirst = "" Then strFirst = strCheck
            If strLast = "" Then strLast = strCheck
            If strFirst > strCheck Then strFirst = strCheck
            If strLast < strCheck Then strLast = strCheck
            'Finds and saves the last column.
            strCheck = strAddresses(lngA)
            If InStr(2, strCheck, ":", vbTextCompare) > 0 Then
                strCheck = Right(strCheck, Len(strCheck) - _
                    InStr(2, strCheck, ":", vbTextCompare))
                strCheck = Mid(strCheck, 2, _
                    InStr(2, strCheck, "$", vbTextCompare) - 2)
                If strLast < strCheck Then strLast = strCheck
            End If
        Next lngA
        'Modifies each condition's address to entire columns.
        oneFormatCondition.ModifyAppliesToRange _
            Range("$" & strFirst & ":$" & strLast)
    Next oneFormatCondition
End Sub

Antwort2

Die Leute beiMrExcel.comkonnten eine sehr elegante Lösung finden.

Es stellte sich heraus, dass es möglich war, die Funktionalität meiner vorhandenen Regeln zur bedingten Formatierung mit nur fünf Zeilen VBA-Code zu replizieren. Das Problem, dass Regeln beim Verschieben der Daten geändert werden, kann nicht mehr auftreten, da die Logik der bedingten Formatierung jetzt von einem kleinen Makro gehandhabt wird.

Ich habe einige Minuten damit verbracht, dies zu testen, und es funktioniert gut. Ich habe jetzt alle meine Regeln zur bedingten Formatierung gelöscht, und das gleiche Verhalten der bedingten Formatierung bleibt in diesem VBA-Code bestehen:

With Range("A1:B200")
  .Interior.Color = xlNone
  .Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 22
  .Offset(, 1).Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 36
End With

Zum Kontext ist hier der gesamte VBA-Code, den ich jetzt in diesem Arbeitsblatt verwende.

Der erste Abschnitt behandelt die automatische alphabetische Sortierung, während dieser neue zweite Abschnitt die bedingte Formatierung behandelt:

Private Sub Worksheet_Change(ByVal Target As Range)

Range("A1:A200").Sort Key1:=Range("A1"), _
  Order1:=xlAscending, Header:=xlNo, _
  OrderCustom:=1, MatchCase:=False, _
  Orientation:=xlTopToBottom

      Range("B1:B200").Sort Key1:=Range("B1"), _
  Order1:=xlAscending, Header:=xlNo, _
  OrderCustom:=1, MatchCase:=False, _
  Orientation:=xlTopToBottom

With Range("A1:B200")
  .Interior.Color = xlNone
  .Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 22
  .Offset(, 1).Resize(, 1).SpecialCells(xlConstants).Interior.ColorIndex = 36
End With

End Sub

verwandte Informationen