0

次の問題に対処できるコードをExcelマクロで見つけようとしています。

最初の列にテキストが含まれている場合、次のテキストが同じ列に表示されなくなるまで、最初の列のセルを特定の色で強調表示します。同じ列にテキストが表示されたら、セルを別の色で塗り始めます。

ワークブックのすべてのワークシートに対してこれを繰り返す必要があります。ありがとう。

ここに画像の説明を入力

現在、このマクロを使用して空のセルに色を付けていますが、問題は、テキストが検出されるたびに色が変わらないことです

Sub try()
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 200
j = 100
k = 5

Application.ScreenUpdating = False

With ActiveSheet.UsedRange
    .AutoFilter Field:=1, Criteria1:=""
    If WorksheetFunction.CountBlank(.Columns(1)) > 0 Then
        .Columns(1).SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(i, j, k)
    Else
        i = i - 50
        j = j - 10
        k = 255
    End If

    .AutoFilter
End With

Application.ScreenUpdating = True

End Sub
4

1 に答える 1

1

どうぞ：

Option Explicit

Sub Color_Ranges()

Dim oSheet                  As Worksheet
Dim oRange                  As Range
Dim oRange_Color            As Range
Dim oBaseCell               As Range
Dim lLast_Row               As Long
Dim lRange_Rows             As Long
Dim iCnt_Values             As Integer
Dim iCnt_Intervals          As Integer

Dim r                       As Integer
Dim g                       As Integer
Dim b                       As Integer

Dim iCnt                    As Integer


Set oSheet = ThisWorkbook.Sheets(1)
With oSheet
    lLast_Row = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
End With

'Total range you want to color
Set oRange = oSheet.Range(Cells(1, 1), Cells(lLast_Row, 1))
lRange_Rows = oRange.Rows.Count

'Count values
iCnt_Values = WorksheetFunction.CountA(oRange)
'Count intervals
iCnt_Intervals = iCnt_Values - 1

'Generate random colors
r = CInt(Int((255 * Rnd()) + 1))
g = CInt(Int((255 * Rnd()) + 1))
b = CInt(Int((255 * Rnd()) + 1))

Set oBaseCell = oRange.Cells(1, 1)
For iCnt = 1 To iCnt_Intervals
    Set oRange_Color = Range(oBaseCell, oBaseCell.End(xlDown))
    oRange_Color.Interior.Color = RGB(r, g, b)
    r = CInt(Int((255 * Rnd()) + 1))
    g = CInt(Int((255 * Rnd()) + 1))
    b = CInt(Int((255 * Rnd()) + 1))
    Set oBaseCell = oBaseCell.End(xlDown)
    Set oRange_Color = Nothing
Next iCnt

End Sub
于 2012-10-25T14:12:11.583 に答える