全シート走査 

全シート走査 version1.0

シート走査処理を行う。
ここでは一例のソースを記載。
用途に合わせて適宜変更をされたし。

'全シートを走査する
Sub scanWithAllSheets()
    Dim topSheet As Worksheet
    Set topSheet = Sheets(1)
    Dim s As Worksheet
    
    For i = 2 To Worksheets.Count
        Set s = Worksheets(i)
        topSheet.Cells(i, 2) = s.Name
        findedCellAddress = findCellInCheckValue(s, "★")
        If findedCellAddress <> "" Then
            topSheet.Cells(i, 3) = Range(findedCellAddress).Row
            topSheet.Cells(i, 4) = Range(findedCellAddress).Column
            topSheet.Cells(i, 5) = s.Cells(Range(findedCellAddress).Row, Range(findedCellAddress).Column)
        End If
    Next
 
End Sub

'シートを指定し値のあるセルを探す
Function findCellInCheckValue(s As Worksheet, findValue As String)
    Dim findedAdress As String
    Dim lastCellAddress As String: lastCellAddress = s.UsedRange(s.UsedRange.Count).Address
    Dim lastCellRow As String: lastCellRow = Range(lastCellAddress).Row
    Dim lastCellColumn As String: lastCellColumn = Range(lastCellAddress).COLUMN
    For i = 1 To lastCellRow
        For j = 1 To lastCellColumn
            If s.Cells(i, j) = findValue Then
                findedAdress = s.Cells(i, j).Address
                '見つかったのでbreak処理
                i = lastCellRow
                j = lastCellColumn
            End If
        Next
    Next
    findCellInCheckValue = findedAdress
End Function


コメント