■

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