Excel – Zellen basierend auf Farbe sperren?

Question

Ich habe dieses Excel-Blatt, in dem ich einige Zellen vor Formatierung und Bearbeitung schützen möchte. Alle diese Zellen sind mit einer bestimmten Farbe eingefärbt.

Das Blatt ist sehr groß und deshalb suche ich nach einer Möglichkeit, alle diese Zellen auf einmal zu sperren und dann alle anderen Zellen massenhaft zu formatieren, ohne die Zellen zu ändern, die ich sperren möchte.

Gibt es eine Möglichkeit, Excel anzuweisen, Zellen mit einer bestimmten Farbe zu sperren?

Answer 1

Ja, mit VBa... Einfach das in das "ThisWorkbook" im Visual Basic Screen kopieren und dann ausführen (grünes Play-Dreieck)

Sub WalkThePlank()

    dim colorIndex as Integer
    colorIndex = 3                   'UPDATE ME TO YOUR COLOUR OR BE FED TO THE SHARKS   

    Dim rng As Range

    For Each rng In ActiveSheet.UsedRange.Cells

        Dim color As Long
        color = rng.Interior.ColorIndex
        If (color = colorIndex) Then   
            rng.Locked = True
        else
            rng.Locked = false    'this will remove any locks for those not in the given color
        End If

    Next rng

End Sub

In VBa gibt es keine Rückgängig-Funktion. Machen Sie also zuerst eine Kopie Ihrer Datei (um eine Sicherungskopie zu erstellen)!

Farbindex -http://dmcritchie.mvps.org/excel/colors.htm

Wie füge ich VBA in MS Office hinzu?

Das Obige setzt voraus, dass Sie keine verbundenen Zellen haben und dass Ihr Arbeitsblatt nicht geschützt ist.

Wenn Sie nicht sicher sind, welchen Farbindex Sie benötigen, verwenden Sie zunächst dieses Skript

Sub Find()

Dim colorIndexFinder As Integer
colorIndexFinder = Range("A1").Interior.colorIndex  'CHANGE A1 to the cell with the colour you want to use
MsgBox (colorIndexFinder)

End Sub

---

Bearbeiten

Sie haben erwähnt, dass Sie zusammengeführte Zellen verwenden

Bitte versuche

Sub WalkThePlank()

Dim colorIndex As Integer
colorIndex = 3                   'UPDATE ME TO YOUR COLOUR OR BE FED TO THE SHARKS

Dim rng As Range

For Each rng In ActiveSheet.UsedRange.Cells

    Dim color As Long
    color = rng.Interior.colorIndex

    If (color = colorIndex) Then
        If (rng.MergeCells) Then
            rng.MergeArea.Locked = True
        Else
            rng.Locked = True
        End If
    Else
        If (rng.MergeCells) Then
            rng.MergeArea.Locked = False
        Else
            rng.Locked = False
        End If
    End If

    Next rng

End Sub

Answer 2

ich habe gefundenDasmithilfe eines einfachen Makros:

Markieren Sie das gesamte Blatt (Ctrl+A)und entsperren Sie alle Zellen. Verwenden Sie anschließend dieses Makro, um die farbigen Zellen wieder zu sperren:

Dim c As Object 
For Each c In selection 
    If c.ColorIndex = 6 ' 6 is for Yellow - change to the colour you want
    c.Locked = True 
End If 
Next c 

Answer 3

VBA-Lösung (Wie füge ich VBA in MS Office hinzu?)

Sub LockOnlyCellsWithCertainColor()
    'Change to your color
    Const colorToLock = 65535

    Dim currentCell As Range

    ActiveSheet.Cells.Locked = False

    For Each currentCell In ActiveSheet.UsedRange.Cells
        If currentCell.Interior.Color = colorToLock Then
            If currentCell.MergeCells Then
                currentCell.MergeArea.Locked = True
            Else
                currentCell.Locked = True
            End If
        End If
    Next

End Sub

Sub GetBackgroundColorOfActiveCell()
    Debug.Print ActiveCell.Interior.Color
    MsgBox ActiveCell.Interior.Color
End Sub

Answer 4

Das Folgende funktioniert bei mir, solange Sie zuerst den Blattschutz aufheben. Der Farbindex ist auf 6 für Gelb eingestellt.

Sub Lock_by_Color()
Dim colorIndex As Integer
Dim Range As Range

colorIndex = 6
For Each Range In ActiveSheet.UsedRange.Cells
Dim color As Long
 color = Range.Interior.colorIndex
If (color = colorIndex) Then
 Range.Locked = True
Else
 Range.Locked = False
End If
Next Range

ActiveSheet.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub