
VBA を使用して条件付き書式ルールを作成し、それを複数のセルに適用しようとしています。
私は、1 つのセルのみにルールを作成し、各 formatcondition オブジェクトの appliedto プロパティを編集することでこれを試みました。こちらをご覧ください:
Sub test()
Dim strRange As String
Dim myRange As Range
strRange = "$B$4,$B$9:$BS$9"
With Sheets("Sheet1").Range("B4")
.FormatConditions.Delete
.FormatConditions.Add xlExpression, xlEqual, "=ISBLANK(RC)"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).StopIfTrue = True
.FormatConditions(1).AppliesTo = strRange
End With
End Sub
これは機能しないようです。AppliesTo 行に到達すると、formatcondition の AppliesTo プロパティを変更するのではなく、実際にセル自体の値が変更されるからです。
セルの条件付き書式ルールの「適用先」プロパティを変更する最適な方法は何ですか?
「with」ステートメントを変更して、セル B4 だけでなく、変更したい他のセルも含めることができることはわかっています。これの問題は、range() オブジェクトが 1024 文字以下の文字列引数しか受け入れないことです。実際、私はこのルールを、1024 文字の制限を超える多数の非連続セルに適用したいと考えています。
答え1
ModifyAppliesToRange
方法があるこの目的のために設計されたstrRange
また、 Range オブジェクトに変換する必要があります。
.FormatConditions(1).AppliesTo = strRange
と 置換する
.FormatConditions(1).ModifyAppliesToRange Range(strRange)
答え2
セルを切り取って貼り付けた後に条件付き書式が複数の領域に適用され、同様の問題が発生しました。例: (E4:G4、E6:G6 など)
基本的に、範囲の範囲を決定し、ModifyAppliesToRange を使用して更新する必要がありました。
Sub FixCondFormatDupRules()
'
Dim ws As Worksheet
Dim MyList As ListObject
Dim lRows As Long
Dim rngData As Range
Dim rngRow1 As Range
Dim rngRow2 As Range
Dim rngRowLast As Range
Set ws = ActiveSheet
Set MyList = ws.ListObjects(1) 'Note this only captures the first table in the ActiveSheet. Wouldn't work if >1 table.
Set rngData = MyList.DataBodyRange
lRows = rngData.Rows.Count
Set rngRow1 = rngData.Rows(1)
Set rngRow2 = rngData.Rows(2)
Set rngRowLast = rngData.Rows(lRows)
With ws.Range(rngRow2, rngRowLast)
.FormatConditions.Delete
End With
' Expanding the Conditional Formatting AppliesTo range to the extent of the ranges and to include the entire table column.
For Each col In rngRow1.Columns
For Each fc In Range(col.Address).FormatConditions
Set FirstCell = col 'Find upper-left cell (lowest row, lowest col)
Set LastCell = Cells(rngRowLast.Row, col.Column) 'Find lower-right cell (highest row, highest col)
For Each xCell In fc.AppliesTo.Cells
If xCell.Column < FirstCell.Column Then Set FirstCell = Cells(FirstCell.Row, xCell.Column)
If xCell.Column > LastCell.Column Then Set LastCell = Cells(LastCell.Row, xCell.Column)
If xCell.Row < FirstCell.Row Then Set FirstCell = Cells(xCell.Row, FirstCell.Column)
If xCell.Row > LastCell.Row Then Set LastCell = Cells(xCell.Row, LastCell.Column)
Next xCell
fc.ModifyAppliesToRange Range(FirstCell, LastCell)
Next fc
Next col
rngRow1.Cells(1, 1).Select
Application.CutCopyMode = False
End Sub