テスト31

```vb

Private Sub calc1()

'2個の組み合わせを計算する
Dim i As Long
Dim j As Long
Dim c As Long

Dim Last_Row As Long

Dim Dic1 As Variant
Dim Dic2 As Variant
Dim Dic_Ans As Variant
Dim Dic_Adjust As Variant

Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
Set Dic_Ans = CreateObject("Scripting.Dictionary")
Set Dic_Adjust = CreateObject("Scripting.Dictionary")

c = 0

Last_Row = ThisWorkbook.Sheets("再帰テスト").Cells(Rows.Count, 1).End(xlUp).Row

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Last_Row
        
            Dic1.Add CStr(i), .Cells(i, 1).Value
            Dic2.Add CStr(i), .Cells(i, 1).Value
        
    Next i

End With
'------------------------------------------------------------

For i = 1 To 1
    
    For j = 1 To Dic2.Count
        
        If i <> j Then
        
            c = c + 1
            Dic_Ans.Add CStr(c), Dic1.Items()(i - 1) + Dic2.Items()(j - 1)

        End If
    
    Next j
    
Next i

'------------------------------------------------------------

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Dic_Ans.Count
    
        .Cells(i, 4).Value = Dic_Ans.Items()(i - 1)
    
    Next i

End With


End Sub

'=====================================
Private Sub calc2()

'3個の組み合わせを計算する
Dim i As Long
Dim j As Long
Dim j1 As Long

Dim k As Long
Dim k1 As Long

Dim c As Long

Dim Last_Row As Long

Dim Dic1 As Variant
Dim Dic2 As Variant
Dim Dic3 As Variant
Dim Dic_Ans As Variant

Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
Set Dic3 = CreateObject("Scripting.Dictionary")
Set Dic_Ans = CreateObject("Scripting.Dictionary")

c = 0

Last_Row = ThisWorkbook.Sheets("再帰テスト").Cells(Rows.Count, 1).End(xlUp).Row

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Last_Row
        
            Dic1.Add CStr(i), .Cells(i, 1).Value
            Dic2.Add CStr(i), .Cells(i, 1).Value
            Dic3.Add CStr(i), .Cells(i, 1).Value
        
    Next i

End With

'------------------------------------------------------------

j1 = 2
k1 = 3
For i = 1 To 1 'Dic1.Count
    
    For j = j1 To Dic2.Count
    
        For k = k1 To Dic3.Count
        
            If i <> j And i <> k And j <> k Then
                
                c = c + 1
                Dic_Ans.Add CStr(c), Dic1.Items()(i - 1) + Dic2.Items()(j - 1) + Dic3.Items()(k - 1)
                
                If Dic3.Count = k Then
                
                    k1 = k1 + 1
                    
                End If

            End If
        
        Next k
    
    Next j
    
Next i

'------------------------------------------------------------

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Dic_Ans.Count
    
        .Cells(i, 4).Value = Dic_Ans.Items()(i - 1)
    
    Next i

End With


End Sub

'=====================================
Private Sub calc3()

'4個の組み合わせを計算する
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long

Dim j1 As Long
Dim k1 As Long
Dim m1 As Long

Dim c As Long

Dim Last_Row As Long

Dim Dic1 As Variant
Dim Dic2 As Variant
Dim Dic3 As Variant
Dim Dic4 As Variant
Dim Dic_Ans As Variant

Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
Set Dic3 = CreateObject("Scripting.Dictionary")
Set Dic4 = CreateObject("Scripting.Dictionary")
Set Dic_Ans = CreateObject("Scripting.Dictionary")

c = 0

Last_Row = ThisWorkbook.Sheets("再帰テスト").Cells(Rows.Count, 1).End(xlUp).Row

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Last_Row
        
            Dic1.Add CStr(i), .Cells(i, 1).Value
            Dic2.Add CStr(i), .Cells(i, 1).Value
            Dic3.Add CStr(i), .Cells(i, 1).Value
            Dic4.Add CStr(i), .Cells(i, 1).Value
        
    Next i

End With

'------------------------------------------------------------

j1 = 2
k1 = 3
m1 = 4

For i = 1 To 1
    
    For j = j1 To Dic2.Count - 2
    
        For k = k1 To Dic3.Count - 1
        
            For m = m1 To Dic4.Count
            
                If i <> j And i <> k And i <> m And j <> k And j <> m And k <> m Then
                
                    c = c + 1
                    Dic_Ans.Add CStr(c), Dic1.Items()(i - 1) + Dic2.Items()(j - 1) + Dic3.Items()(k - 1) + Dic4.Items()(m - 1)
                    
                    If Dic4.Count = m Then
                    
                        m1 = m1 + 1
                        
                        If m1 = 11 Then
                        
                            m1 = k1 + 2
                        
                        End If
                        
                    End If
    
                End If
            
            Next m
            
            If Dic3.Count - 1 = k Then
            
                k1 = j1 + 1
            
            End If
        
        Next k
    
    Next j
    
Next i

'------------------------------------------------------------

With ThisWorkbook.Sheets("再帰テスト")

    For i = 1 To Dic_Ans.Count
    
        .Cells(i, 4).Value = Dic_Ans.Items()(i - 1)
    
    Next i

End With


End Sub