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
コメント