いくつかのセルをフォーマットや編集から保護したいこのExcelシートがあります。これらのセルはすべて特定の色で着色されています。
シートは非常に大きいので、これらすべてのセルを一度にロックして、ロックしたいセルを変更せずに他のすべてのセルを一括フォーマットできる方法を探しています。
特定の色のセルをロックするようにExcelに指示する方法はありますか?
はい、VBaを使用しています...これをVisual Basic画面の「ThisWorkbook」にコピーして実行します(緑色の再生三角形)
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
VBaには元に戻す機能がないため、最初にファイルのコピーを取ります(バックアップを作成するため)。
カラーインデックス- http://dmcritchie.mvps.org/Excel/colors.htm
MS OfficeにVBAを追加するにはどうすればよいですか?
上記は、結合されたセルがなく、ワークシートが保護されていないことを前提としています。
必要なcolorIndexがわからない場合は、最初にこのスクリプトを使用してください
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
編集
マージされたセルを使用するとおっしゃいました
してみてください
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
単純なマクロを使用して this 方法を見つけました:
シート全体を選択してください(Ctrl+A)
そしてすべてのセルのロックを解除してから、このマクロを使用して、色付きのセルを再度ロックするように設定します。
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
Vbaソリューション( MS OfficeにVBAを追加するにはどうすればよいですか? )
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
以下は、最初にシートの保護を解除する限り機能します。黄色の場合、カラーインデックスは6に設定されます。
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