色つきの最初と最後

質問

excel vba 初心者です。
詳しくは添付致しますが、
今B1～X1に1～23までの数値を入れ、
その下に色をつけます。

その色が付いている部分の最初の数と最後の数を抽出したいのですが
何かいい方法は無いでしょうか？

2行目だったら最初は3最後は15みたいな

回答No.2

AKARI0418

アクティブなセルの位置から２３カラム右方向へチェックを行い、一番最初に発見した色つきセルの範囲を求めます。

Sub ColorCheck()

Const CheckCount As Long = 23 'チェックするセル数

Dim i As Long
Dim CheckRow As Long 'チェックする行
Dim StartColumn As Long 'チェック開始列
Dim EndColumn As Long 'チェック終了列
Dim StartPos As Integer '色つき開始列
Dim EndPos As Integer '色つき終了列

CheckRow = ActiveCell.Row
StartColumn = ActiveCell.Column
EndColumn = StartColumn + CheckCount
StartPos = 0

For i = StartColumn To EndColumn
If Cells(CheckRow, i).Interior.ColorIndex <> xlNone And StartPos = 0 Then
StartPos = i
ElseIf Cells(CheckRow, i).Interior.ColorIndex <> xlNone Then
EndPos = i
ElseIf StartPos <> 0 And EndPos <> 0 And Cells(CheckRow, i).Interior.ColorIndex = xlNone Then
Exit For
End If
Next i

MsgBox ("開始位置=" & StartPos & ",終了位置=" & EndPos)
End Sub