0

私のExcelファイルには、数式を含むテーブルが設定されています。

Range("B2:B12")、Range ("D2:D12") などの Cells で、これらの数式の答えを含む 1 行おきに。

これらのセル (数式の回答を含む) には、条件付き書式を適用する必要がありますが、7 つの条件があるため、VBA で「大文字と小文字を選択」を使用して、番号に基づいて内部の背景を変更しています。独自のマクロではなく、シートコード内に現在設定されているケース選択機能があります

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColor As Integer
    If Not Intersect(Target, Range("B2:L12")) Is Nothing Then
        Select Case Target
            Case 0
                iColor = 2
            Case 0.01 To 0.49
                iColor = 36
            Case 0.5 To 0.99
                iColor = 6
            Case 1 To 1.99
                iColor = 44
            Case 2 To 2.49
                iColor = 45
            Case 2.5 To 2.99
                iColor = 46
            Case 3 To 5
                iColor = 3
        End Select
        Target.Interior.ColorIndex = iColor
    End If
End Sub

ただし、この方法を使用すると、書式設定が機能するために実際にセルに値を入力する必要があります。

これが、これをマクロとして行うためのサブルーチンを書きたい理由です。データを入力し、数式を機能させ、すべての準備が整ったら、マクロを実行して特定のセルをフォーマットします。

これを行う簡単な方法が必要です。明らかに、すべてのセルのすべてのケースを入力して時間を浪費する可能性がありますが、ループを使用すると簡単になると考えました。

特定の範囲のセルのフォーマットを 1 行おきに変更するには、select case ループをどのように作成すればよいでしょうか。

前もって感謝します。

4

2 に答える 2

1

以下は、範囲内のすべてのセルを通過し、ColorIndex を設定する非常に基本的なループです。（私はそれを試していませんが、うまくいくはずです）

Private Function getColor(ByVal cell As Range) As Integer
    Select Case cell
        Case 0
            getColor = 2: Exit Function
        Case 0.01 To 0.49
            getColor = 36: Exit Function
        Case 0.5 To 0.99
            getColor = 6: Exit Function
        Case 1 To 1.99
            getColor = 44: Exit Function
        Case 2 To 2.49
            getColor = 45: Exit Function
        Case 2.5 To 2.99
            getColor = 46: Exit Function
        Case 3 To 5
            getColor = 3: Exit Function
    End Select
End Function

Private Sub setColor()
Dim area As Range
Dim cell As Range

Set area = Range("B2:L12")
    For Each cell In area.Cells
        cell.Interior.ColorIndex = getColor(cell)
    Next cell
End Sub

編集：それは今動作します。ColorIndex の前に Interior を追加し、ByRef を ByVal に設定するのを忘れていました。ところで。コメントを私の回答にコメントとして追加してください。

Edit2:値を変更するときの Errormsg について:

「あいまいな名前が検出されました: setColor」

worksheet_change にまだコードが残っていると思います。サブをどのように実行したいかについては言及していません。

worksheet_change で実行したい場合は、(モジュールではなく) vba のワークシートにコードを追加し、setcolor を呼び出すだけです。setColor は 1 つしか存在できないため、モジュールまたはワークシートのいずれかにあることを確認してください。

モジュールから実行したい場合は、変更する必要があります

Private Sub setColor()

に

Public Sub setColor()

また、Range の前に The worksheetname または ActiveSheet を追加することをお勧めします。このような：

Set area = ActiveSheet.Range("B2:L12")
于 2009-12-03T17:03:31.403 に答える
0 
Option Explicit
Private Function getColor(cell As Range) As Integer
    Select Case cell
        Case 0
            getColor = 2: Exit Function
        Case 0.01 To 0.49
            getColor = 36: Exit Function
        Case 0.5 To 0.99
            getColor = 6: Exit Function
        Case 1 To 1.99
            getColor = 44: Exit Function
        Case 2 To 2.49
            getColor = 45: Exit Function
        Case 2.5 To 2.99
            getColor = 46: Exit Function
        Case 3 To 5
            getColor = 3: Exit Function
    End Select
End Function
Public Sub setColor()
Dim area As Range
Dim cell As Range

Set area = Range("B2:L12")
    For Each cell In area.Cells
        cell.Interior.ColorIndex = getColor(cell)
    Next cell
End Sub

編集:@margの回答を受け入れてください。
私は単に彼のコードを使用し、コンパイル時のエラーを引き起こしたいくつかのことを修正しました。

于 2009-12-03T18:11:09.610 に答える