| ■No97735 (魔界の仮面弁士 さん) に返信
> 2021/07/07(Wed) 11:42:25 編集(投稿者)
>
> ■No97733 (工場プログラマー さん) に返信
>>列の指定がなかったですね、4列目から最終行です。
>
> 4「列」目から最終「行」、という表現に違和感が…。
>
> 「1 行目以降、最終行まで」の各行を
> 「4 列目以降、最終列まで」の範囲で調べていくということですかね?
ごめんなさい、4行目から最終行といいたかったです、、
> Option Explicit
>
> Public Sub Wankuma97715(Optional ByVal targetSheet As Excel.Worksheet)
> Const CELL_MARK_COLOR As Long = vbRed
> Const CELL_FIND_COLOR As Long = vbYellow '探索対象の色
> Const CELL_FIND_COUNT As Long = 4 '探索を打ち切る数(1以上)
> Const START_ROW As Long = 1 '探索開始行(1以上)
> Const START_COL As Long = 4 '探索開始列(2以上)
>
> If targetSheet Is Nothing Then
> Set targetSheet = ThisWorkbook.ActiveSheet
> End If
> Dim rng As Excel.Range
> Set rng = targetSheet.UsedRange
>
> ' A 列の背景色を事前にクリアしておく
> targetSheet.Columns(1).Interior.ColorIndex = xlColorIndexNone
>
> Dim rowIndex As Long, colIndex As Long
> Dim colorCount As Long
> For rowIndex = WorksheetFunction.Max(rng.Row, START_ROW) To rng.Row + rng.Rows.Count - 1
> colorCount = 0
> For colIndex = START_COL To rng.Column + rng.Columns.Count - 1
> If targetSheet.Cells(rowIndex, colIndex).DisplayFormat.Interior.Color = CELL_FIND_COLOR Then
> colorCount = colorCount + 1 '該当する背景色を発見
> If colorCount >= CELL_FIND_COUNT Then
> '既定数に達したので A 列を着色
> targetSheet.Cells(rowIndex, 1).Interior.Color = CELL_MARK_COLOR
> 'この行の探索を打ち切って次行へ
> Exit For
> End If
> End If
> Next
> Next
> End Sub
参考にしてこんな感じで作れました。
Dim i, j, iRow, MaxRow, MaxCol, yellow_cnt As Long
MaxRow = Cells(Rows.Count, 4).End(xlUp).Row
MaxCol = Cells(7, Columns.Count).End(xlToLeft).Column
iRow = 7
For i = 7 To MaxRow
For j = 4 To MaxCol '列の端までいったら抜ける
If Cells(iRow, j).Interior.ColorIndex = 6 Then '黄色の判定
yellow_cnt = yellow_cnt + 1 '行内の黄色セルをカウント
If yellow_cnt >= 4 Then '4以上で1列目を背景色を赤色に変更
Cells(iRow, 1).Interior.ColorIndex = 3
End If
End If
Next j
iRow = iRow + 1 '次の行へ
yellow_cnt = 0 'カウントを0に戻す
Next i
皆さん、たくさんのご回答ありがとうございました。 |