Public Type KEITO
ride_serialNum As Integer
getoff_serialNum As Integer
unchinData As Integer
End Type
Public Type UNCHIN
sheetName As String
keito_data() As KEITO
End Type
Public unchinData() As UNCHIN
Public Enum UnchinSheetColumn
serialNum = 1
keitoNum = 2
seiriNum = 4
End Enum
Sub さんかくtest()
Dim sankaku_s As Worksheet
Dim sankakuRow_pos As Integer
Dim sankakuCol_pos As Integer
Dim seiri_cnt As Integer
Dim loop_flg As Boolean
Dim seiriLoop_flg As Boolean
Dim genkin As Integer
Dim sankakuData As Variant
Dim nextRowCount As Integer
Dim keito_data As Variant
Dim loop_keitoCount As Long
Dim row_pos As Long
Dim col_po As Integer
Dim lastColumnCount As Integer
Dim lastRowCount As Long
Dim KEITO() As String
Dim loop_setKeitoCnt As Integer
Dim unchin_flg As Boolean
Dim dicSeiriColumnData As Object
Dim loop_columnflg As Boolean
Dim dicKeitoData As Object
Dim loop_sankakuRowCnt As Long
Dim keito_wk As String
Dim keito_wkCnt As Integer
Dim serial_number As Integer
Dim seiri_number As Integer
Dim ride_serialNum As Integer
Dim ride_seiriNum As Integer
Set dicSeiriColumnData = CreateObject("Scripting.Dictionary")
Set dicKeitoData = CreateObject("Scripting.Dictionary")
Set sankaku_s = ThisWorkbook.Worksheets("Sheet1")
'intでいいかは確認
Dim keto_cd As Integer
seiri_cnt = -1
loop_flg = True
ofuku_flg = False
'シートの最終行、最終列を取得
lastRowCount = WorksheetFunction.Match("E", sankaku_s.Range("A:A"), 0) - 1
lastColumnCount = WorksheetFunction.Match("E", sankaku_s.Range("3:3"), 0) - 1
'コードは呼び出し時一意
' keto_cd = keto_cd + 1
' ReDim Preserve UnchinData(keto_cd) As Unchin
'列データ取得
sankakuData = sankaku_s.Range("$A$3:" & sankaku_s.Cells(lastRowCount, lastColumnCount).Address)
row_pos = 1
col_pos = UBound(sankakuData, 2)
loop_columnflg = True
While loop_columnflg = True
If sankakuData(1, col_pos) <> "" Then
dicSeiriColumnData.Add sankakuData(1, col_pos), col_pos
Else
loop_columnflg = False
End If
col_pos = col_pos - 1
Wend
'系統データを取得
ReDim Preserve KEITO(0) As String
sankakuData = sankaku_s.Range("$A$4:" & sankaku_s.Cells(lastRowCount, lastColumnCount).Address)
For loop_keitoCount = 1 To UBound(sankakuData)
If sankakuData(loop_keitoCount, 2) <> "" And dicKeitoData.exists(sankakuData(loop_keitoCount, 2)) = False Then
ReDim Preserve KEITO(UBound(KEITO)) As String
dicKeitoData.Add sankakuData(loop_keitoCount, 2), loop_keitoCount
keito_wk = sankakuData(loop_keitoCount, 2)
End If
dicKeitoData(keito_wk) = loop_keitoCount
Next
ReDim Preserve unchinData(0) As UNCHIN
ReDim Preserve unchinData(0).keito_data(0) As KEITO
For loop_sankakuRowCnt = 1 To UBound(sankakuData)
unchinData(UBound(unchinData)).sheetName = sankakuData(row_pos, 2)
unchin_flg = True
keito_wkCnt = dicKeitoData(sankakuData(row_pos, 2))
unchin_flg = True
While unchin_flg = True
ride_seiriNum = sankakuData(row_pos, UnchinSheetColumn.seiriNum)
ride_serialNum = sankakuData(row_pos, UnchinSheetColumn.serialNum)
'ReDim Preserve UnchinData(UBound(UnchinData)).keito_data(UBound(UnchinData)) As KEITO
loop_setKeitoCnt = 1
While row_pos + loop_setKeitoCnt <= keito_wkCnt
unchinData(UBound(unchinData)).keito_data(UBound(unchinData(UBound(unchinData)).keito_data)).getoff_serialNum = sankakuData(row_pos + loop_setKeitoCnt, UnchinSheetColumn.serialNum)
unchinData(UBound(unchinData)).keito_data(UBound(unchinData(UBound(unchinData)).keito_data)).unchinData = sankakuData(row_pos + loop_setKeitoCnt, dicSeiriColumnData(ride_seiriNum))
unchinData(UBound(unchinData)).keito_data(UBound(unchinData(UBound(unchinData)).keito_data)).ride_serialNum = ride_serialNum
If row_pos + loop_setKeitoCnt + 1 <= keito_wkCnt Then
ReDim Preserve unchinData(UBound(unchinData)).keito_data(UBound(unchinData(UBound(unchinData)).keito_data) + 1) As KEITO
End If
loop_setKeitoCnt = loop_setKeitoCnt + 1
Wend
If row_pos >= keito_wkCnt Then
unchin_flg = False
End If
row_pos = row_pos + 1
Wend
If dicKeitoData.Count > (UBound(unchinData) + 1) Then
ReDim Preserve unchinData(UBound(unchinData) + 1) As UNCHIN
End If
Next
End Sub