1245678
anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 10000000 '試行数値の最初の数値
    Const tryTimes As Long = 100 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲 ※処理速度に影響を与えるため、tryMinに応じて要変更
    'culcTiemsCapa = 1000で tryMin = 10000000程度までは実行可能か
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 1
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then 'Rigth関数はオーバーフロー対策
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        arr(0, col) = row - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = row + 1 To culcTiemsCapa
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    collatz = arr
End Function

anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 1 '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲 ※処理速度に影響を与えるため、tryMinに応じて要変更
    'culcTiemsCapa = 1000で tryMin = 10000000程度までは実行確認済み
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 1
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        arr(0, col) = row - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = row + 1 To culcTiemsCapa
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    collatz = arr
End Function

anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 1 '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲 ※処理速度に影響を与えるため、tryMinに応じて要変更
    'culcTiemsCapa = 1000で tryMin = 10000000程度までは実行確認済み
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa - 1, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = row + 1 To culcTiemsCapa - 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    collatz = arr
End Function
anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 1 '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲
    '※処理速度に影響を与えるため、tryMinに応じて要変更
    'culcTiemsCapa = 1000で tryMin = 10000000程度までは実行確認済み
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa - 1, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        'このループはスピルで使用する場合はあった方が良い
        For j = row + 1 To culcTiemsCapa - 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    collatz = arr
End Function

anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 10000000  '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲
    '※処理速度に影響を与えるため、tryMinに応じて変更
    'culcTiemsCapa = 1000で tryMin = 10000000程度までは実行確認済み
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa - 1, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        'このループはスピルで使用する場合はあった方が良い
        For j = row + 1 To culcTiemsCapa - 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    collatz = arr
End Function

anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 1  '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。※上限16384(Excelの最大列数)
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa - 1, tryTimes - 1) As Variant
    Dim i As Variant, j As Long
    Dim n As Variant, row As Long, col As Long
    
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If Right(n, 1) Mod 2 = 0 Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        For j = row + 1 To culcTiemsCapa - 1 'このループはスピルで使用する場合はあった方が良い
            arr(j, col) = ""
        Next
        col = col + 1
    Next
    collatz = arr
End Function
anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Long = 1
    Const tryTimes As Long = 1000 '上限16384(Excelの最大列数)
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Long, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Long: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTiemsCapa, tryTimes) As Variant
    Dim i As Long, row As Long, col As Long
    Dim n As Variant
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If WorksheetFunction.IsEven(n) Then
                n = n / 2
            Else
                n = n * 3 + 1
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        col = col + 1
    Next
    collatz = arr
End Function

anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Long = 1
    Const tryTimes As Long = 1000 '上限16384(Excelの最大列数)
    Dim tryMax As Long: tryMax = tryMin + tryTimes - 1
    Const culcTiemsCapa As Long = 500 '計算回数許容範囲
    
    Range("A1").Resize(culcTiemsCapa, tryTimes) = collatz(tryMin, tryMax, tryTimes, culcTiemsCapa)
                
End Sub

Function collatz( _
    ByVal tryMin As Long, _
    ByVal tryMax As Long, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    ReDim arr(culcTiemsCapa, tryTimes) As Variant
    Dim i As Long, n As Long, row As Long, col As Long
    
    For i = tryMin To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If n Mod 2 Then
                n = n * 3 + 1
            Else
                n = n / 2
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        col = col + 1
    Next
    collatz = arr
End Function


anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMax As Long = 1000
    Range("A1").Resize(tryMax, tryMax) = korattu(tryMax)
                
End Sub

Function korattu(ByVal tryMax As Long) As Variant
    
    ReDim arr(tryMax, tryMax) As Variant
    Dim i As Long, n As Long, row As Long, col As Long
    
    For i = 1 To tryMax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If n Mod 2 Then
                n = n * 3 + 1
            Else
                n = n / 2
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        col = col + 1
    Next
    korattu = arr
End Function


anonymous No title
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const trymax As Long = 1000
    Range("A1").Resize(trymax, trymax) = korattu(trymax)
                
End Sub

Function korattu(ByVal trymax As Long) As Variant
    
    ReDim arr(trymax, trymax) As Variant
    Dim i As Long, n As Long, row As Long, col As Long
    
    For i = 1 To trymax
        n = i
        row = 0
        arr(row, col) = n
        Do While n <> 1
            If n Mod 2 Then
                n = n * 3 + 1
            Else
                n = n / 2
            End If
            row = row + 1
            arr(row, col) = n
        Loop
        col = col + 1
    Next
    korattu = arr
End Function
Don't you submit code?
Submit
1245678