色つきの最初と最後

質問

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

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

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

回答No.4

hige_082

こんな方法は如何

手順
１　開始セルは、左から順番に右方向へ、最初に色のついたセルを求める
２　終了セルは、右から順番に左方向へ、最初に色のついたセルを求める

以上

コードにすると

Sub test()
Dim 処理行, 開始セル, 終了セル As Integer

'２行目から順に最終行まで処理します
For 処理行 = 2 To Range("a65536").End(xlUp).Row

'処理行の開始セルを求める処理
For 開始セル = 1 To 23
If Cells(処理行, 開始セル + 1).Interior.ColorIndex <> xlNone Then Exit For
Next 開始セル

'処理行の終了セルを求める処理
For 終了セル = 23 To 1 Step -1
If Cells(処理行, 終了セル + 1).Interior.ColorIndex <> xlNone Then Exit For
Next 終了セル

'表示処理
MsgBox Cells(処理行, 1).Value & " の最初は " & 開始セル & " 最後は " & 終了セル
Next 処理行
End Sub

こんな感じです
参考までに

回答No.3

n-jun

＃１です。

ところで色をつけるのは手作業ですよね。
条件付き書式による色つけなら、No1はスル～して下さい。

回答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

回答No.1

n-jun

ループで回して色つきかどうかを１つずつ判断して、色があった場所のセル情報を取得する。
とか？