ExcelVBA : 色つきセル検索

開いているブックの全シート中の色つき文字のセルを現在位置から検索するマクロだ。

添削や変更箇所の目視確認に使えし。

AWKのつぼ

ブック中、現シート現位置から検索し、一周するループ処理をしている。
このfor文、パクれるんじゃね?
シート内最終セルは、PrintAreaやSpecialCellのラストデータを計算して総合判断したほうがイイかもな。

Sub 属性検索() Dim n As Integer ' Dim findcell As object ' On Error GoTo erx StartSheet = ActiveSheet.Index StartRow = ActiveCell.Row StartColumn = ActiveCell.Column findcellRow = StartRow findcellColumn = StartColumn findf = False For n = 1 To Worksheets.Count targetSheet = (StartSheet + n - 2) Mod Worksheets.Count + 1 Worksheets(targetSheet).Activate cBottom = ActiveCell.SpecialCells(xlLastCell).Row cRight = ActiveCell.SpecialCells(xlLastCell).Column For y = 1 To cBottom If (StartSheet <> targetSheet) Or (y >= StartRow) Then For x = 1 To cRight If (StartSheet <> targetSheet) Or (y <> StartRow) Or (StartColumn < x) Then If (ActiveSheet.Cells(y, x).Font.Color <> 0) Then findf = True End If If (ActiveSheet.Cells(y, x).Interior.Color <> 16777215) Then findf = True End If If findf Then If (y = findcellRow) And (findcellColumn + 1 = x) Then findcellRow = y findcellColumn = x Else findcellRow = y findcellColumn = x ActiveSheet.Cells(y, x).Activate Exit Sub End If End If End If Next End If Next Next End Sub