0

非常に大きなスプレッドシート (数百のセルに色を付ける) に単純なカラー コードが必要です。CF を使用すると、コンピューターの速度が低下し、Excel がクラッシュするだけです。VBAでやってみたいと思います。以下のコードを試してみましたが、値 (1、2、または 3) を入力した場合にのみ機能します。値が数式の結果の場合は機能しません。何か案が？

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

If Intersect(Target, rng) Is Nothing Then Exit Sub

For Each c In Intersect(Target, rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub

ジャン・フランソワ・コルベットが答えることができれば、それは素晴らしいことです!

4

1 に答える 1

1

@TimWilliamsは正しいですが、ターゲット範囲を再帰的に拡張して、次のようなtarget.dependantsを含めることができます

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

これを変更します：

For Each c In Intersect(Target, rng)

に：

For Each c In Intersect(TargetDependents(Target), rng)

コメントに応じて更新すると、編集されたコードは次のようになります

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

For Each c In Intersect(TargetDependents(Target), rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub
于 2013-01-30T04:04:50.110 に答える