VBA2

Option Explicit
Sub count_end_row(start_row, start_col, end_row)

Dim r As Long

r = ActiveSheet.Rows.count
Cells(r, start_col).End(xlUp).Select

end_row = ActiveCell.Row

End Sub

Sub count_end_col(start_row, start_col, end_col)

Dim c As Long

c = ActiveSheet.Columns.count
Cells(start_row, c).End(xlToLeft).Select

end_col = ActiveCell.Column

End Sub

Sub search_rc_horizon(target_text, start_row, start_col, count, columns_)

Dim i As Long
Dim j As Long
Dim end_col As Long

end_col = 0
Call count_end_col(start_row, start_col, end_col)
count = 0
j = 1
For i = 1 To end_col
    If Cells(start_row, start_col + i - 1).Value = target_text Then
        columns_(j) = start_col + i - 1
        j = j + 1
        count = count + 1
    Else

    End If

Next

End Sub

Sub search_rc_vertical(target_text, start_row, start_col, count, rows_)

Dim i As Long
Dim j As Long
Dim end_row As Long

end_row = 0
Call count_end_row(start_row, start_col, end_row)
count = 0
j = 1
For i = 1 To end_row
    If Cells(start_row + i - 1, start_col).Value = target_text Then
        rows_(j) = start_row + i - 1
        j = j + 1
        count = count + 1
    Else

    End If

Next

End Sub

Sub get_rc_horizon(sheet As String, target_text As String, start_row As Long, start_col As Long, count_, arrays)
Dim end_row As Long
Dim end_col As Long
Dim count As Long

Worksheets(sheet).Activate
end_row = 0
end_col = 0
Call count_end_col(start_row, start_col, end_col)
Call count_end_row(start_row, start_col, end_row)

ReDim rows_(end_row) As Long
ReDim columns_(end_col) As Long

Call search_rc_horizon(target_text, start_row, start_col, count, columns_)

Dim i As Long
count_ = 0
For i = 1 To count
    arrays(i) = columns_(i)
    count_ = count_ + 1
Next

End Sub

Sub get_rc_vertical(sheet As String, target_text As String, start_row As Long, start_col As Long, count_, arrays)
Dim end_row As Long
Dim end_col As Long
Dim count As Long

Worksheets(sheet).Activate
end_row = 0
end_col = 0
Call count_end_col(start_row, start_col, end_col)
Call count_end_row(start_row, start_col, end_row)

ReDim rows_(end_row) As Long
ReDim columns_(end_col) As Long

Call search_rc_vertical(target_text, start_row, start_col, count, rows_)

Dim i As Long
count_ = 0
For i = 1 To count
    arrays(i) = rows_(i)
    count_ = count_ + 1
Next

End Sub

Sub main()
‘ 規則的に散らばった表の行と列の番号を抽出する
Dim target_text As String
Dim start_row As Long
Dim start_col As Long
Dim sheet1 As String
Dim sheet2 As String
Dim end_col As Long
Dim end_row As Long

sheet1 = "Sheet1"
sheet2 = "Sheet4"
start_row = 1
start_col = 1
target_text = "smp"

Worksheets(sheet1).Activate
' 水平方向の探索
end_col = 0
Call count_end_col(start_row, start_col, end_col)
ReDim columns_(end_col) As Long
Call get_rc_horizon(sheet1, target_text, start_row, start_col, end_col, columns_)

' 垂直方向の探索
end_row = 0
Call count_end_row(start_row, start_col, end_row)
ReDim rows_(end_row) As Long
Call get_rc_vertical(sheet1, target_text, start_row, start_col, end_row, rows_)

Worksheets(sheet2).Activate
Dim i As Long
Dim j As Long
For i = 1 To end_row
    For j = 1 To end_col
        Cells(6 + (i - 1) * end_col + (j - 1), 1).Value = rows_(i)
        Cells(6 + (i - 1) * end_col + (j - 1), 2).Value = columns_(j)
    Next
Next

End Sub

コメント

タイトルとURLをコピーしました