anonymous 魔球2
VBA
Sub Makyuu2()

    ' 縦20(1-20) × 横10(A-J) のセル範囲限定
    Dim x As Long, y As Long, arr(21, 11) As Long, Asum As Long, ST_Asum As Long
    
    ' 配列のセル位置に該当する箇所全てに1をセット(初期化) ※更に一回り大きい部分は0になっている
    For y = 1 To 20
        For x = 1 To 10
            arr(y, x) = 1
        Next
    Next
      
    ' 上、右、下、左 それぞれで、罫線が無い隣り合う値に0があれば自身を0にする、前回との差が無ければループを抜ける
    Do
        ST_Asum = Asum
        Asum = 0
        For y = 1 To 20
            For x = 1 To 10
                If Cells(y, x).Borders(xlEdgeTop).LineStyle = -4142 And arr(y - 1, x) = 0 Then arr(y, x) = 0
                If Cells(y, x).Borders(xlEdgeRight).LineStyle = -4142 And arr(y, x + 1) = 0 Then arr(y, x) = 0
                If Cells(y, x).Borders(xlEdgeBottom).LineStyle = -4142 And arr(y + 1, x) = 0 Then arr(y, x) = 0
                If Cells(y, x).Borders(xlEdgeLeft).LineStyle = -4142 And arr(y, x - 1) = 0 Then arr(y, x) = 0
                Asum = Asum + arr(y, x)
            Next
        Next
    Loop While Asum <> ST_Asum
    
    ' セル位置に該当する配列の値が1のとき色を塗る
    For y = 1 To 20
        For x = 1 To 10
            If arr(y, x) = 1 Then Cells(y, x).Interior.Color = vbYellow
        Next
    Next

End Sub
anonymous No title
VBA
Sub VBA100本ノック_22_B()
    Cells.ClearContents
    Dim i As Long
    Dim clm As Long
    Dim talk As Variant
    Dim ans As Variant

    For i = 1 To 30
        Select Case True
            Case i Mod 15 = 0
                ans = "FizzBuzz": clm = 4
                Cells(i, clm) = IIf(talk = "", ans, talk)
            Case i Mod 5 = 0
                ans = "Buzz": clm = 3
                Cells(i, clm) = IIf(talk = "", ans, talk)
            Case i Mod 3 = 0
                ans = "Fizz": clm = 2
                Cells(i, clm) = IIf(talk = "", ans, talk)
            Case Else
                ans = i: clm = 1
                Cells(i, clm) = IIf(talk = "", ans, talk)
        End Select
        Cells(i, clm).Select
        If talk <> "" Then
            If talk <> ans Then
                Cells(i + 1, 1) = "はいダメーー"
                Exit Sub
            Else
                talk = ""
            End If
        End If
        If Int((10 - 1 + 1) * Rnd + 1) = 1 Then
           talk = RandRet(i + 1)
        End If
        Application.Wait [Now() + TimeValue("00:00:00.5")]
    Next
End Sub

Function RandRet(ByVal n As Long) As Variant
    Dim arr As Variant
    arr = Array(n, "Fizz", "Buzz", "FizzBuzz")
    RandRet = arr(WorksheetFunction.RandBetween(0, 3))
End Function
anonymous コラッツ予想 計算過程:列方向へ出力
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Dim tryMin As Variant: tryMin = 1 '試行数値の最初の数値
    Dim tryTimes As Long: tryTimes = 1000 'tyrMinからいくつ計算したいか。
    
    Dim culcTimesCapa As Long: culcTimesCapa = 1000 '計算回数許容範囲
    
    Range("A1").Resize(tryTimes, culcTimesCapa + 2) = CollatzFullHorizontal(tryMin, tryTimes, culcTimesCapa)
                
End Sub

'計算過程:列方向へ出力
Function CollatzFullHorizontal( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTimesCapa As Long) _
    As Variant
    
    If culcTimesCapa = 0 Then culcTimesCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(tryTimes - 1, culcTimesCapa + 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
        col = 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
            col = col + 1
            arr(row, col) = n
        Loop
        arr(row, 0) = col - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = col + 1 To culcTimesCapa + 1
            arr(row, j) = ""
        Next
        '--------------------------------------------
        row = row + 1
    Next
    CollatzFullHorizontal = arr
End Function

anonymous コラッツ予想 計算過程:行方向へ出力
VBA
Sub main()
    Cells.ClearContents
    
    Dim tryMin As Variant: tryMin = 1 '試行数値の最初の数値
    Dim tryTimes As Long: tryTimes = 1000 'tyrMinからいくつ計算したいか。※上限16384(Excelの最大列数)
    
    Dim culcTimesCapa As Long: culcTimesCapa = 1000 '計算回数許容範囲
    
    
    Range("A1").Resize(culcTimesCapa + 2, tryTimes) = CollatzFullVertical(tryMin, tryTimes, culcTimesCapa)
                
End Sub

'計算過程:行方向へ出力
Function CollatzFullVertical( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTimesCapa As Long) _
    As Variant
    
    If culcTimesCapa = 0 Then culcTimesCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTimesCapa + 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 = 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 culcTimesCapa + 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    CollatzFullVertical = arr
End Function

anonymous コラッツ予想 計算過程:行方向へ出力
VBA
Option Explicit

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

'計算過程:行方向へ出力
Function CollatzFullVertical( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTimesCapa As Long) _
    As Variant
    
    If culcTimesCapa = 0 Then culcTimesCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTimesCapa + 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 = 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 culcTimesCapa + 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    CollatzFullVertical = arr
End Function


anonymous No title
VBA
Option Explicit

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

'計算過程:行方向へ出力
Function CollatzFullVertical( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTimesCapa As Long) _
    As Variant
    
    If culcTimesCapa = 0 Then culcTimesCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(culcTimesCapa + 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 = 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 culcTimesCapa + 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    CollatzFullVertical = arr
End Function


anonymous コラッツ予想 計算過程:列方向へ出力
VBA
Option Explicit

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

'計算過程:列方向へ出力
Function CollatzFullHorizontal( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTimesCapa As Long) _
    As Variant
    
    If culcTimesCapa = 0 Then culcTimesCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(tryTimes - 1, culcTimesCapa + 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
        col = 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
            col = col + 1
            arr(row, col) = n
        Loop
        arr(row, 0) = col - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = col + 1 To culcTimesCapa + 1
            arr(row, j) = ""
        Next
        '--------------------------------------------
        row = row + 1
    Next
    CollatzFullHorizontal = arr
End Function

anonymous コラッツ予想 計算過程:列方向へ出力
VBA
Option Explicit

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

'計算過程:列方向へ出力
Function CollatzFullHorizontal( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTiemsCapa As Long) _
    As Variant
    
    If culcTiemsCapa = 0 Then culcTiemsCapa = 1000
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(tryTimes - 1, culcTiemsCapa + 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
        col = 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
            col = col + 1
            arr(row, col) = n
        Loop
        arr(row, 0) = col - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = col + 1 To culcTiemsCapa + 1
            arr(row, j) = ""
        Next
        '--------------------------------------------
        row = row + 1
    Next
    CollatzFullHorizontal = arr
End Function

anonymous コラッツ予想 計算過程:行方向へ出力
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 '計算回数許容範囲(Optional)
    
    
    Range("A1").Resize(culcTiemsCapa + 2, tryTimes) = CollatzFullVertical(tryMin, tryTimes)
                
End Sub

'計算過程:行方向へ出力
Function CollatzFullVertical( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    Optional ByVal culcTiemsCapa As Long) _
    As Variant
    
    If culcTiemsCapa = 0 Then culcTiemsCapa = 1000
    
    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 = 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 + 1
            arr(j, col) = ""
        Next
        '--------------------------------------------
        col = col + 1
    Next
    CollatzFullVertical = arr
End Function
anonymous コラッツ予想 計算過程:列方向へ出力
VBA
Option Explicit

Sub main()
    Cells.ClearContents
    
    Const tryMin As Variant = 1 '試行数値の最初の数値
    Const tryTimes As Long = 1000 'tyrMinから何番目まで計算したいか。
    
    Const culcTiemsCapa As Long = 1000 '計算回数許容範囲
    '※処理速度に影響を与えるため、tryMin + tryTimis < 100000000までは1000固定
    
    Range("A1").Resize(tryTimes, culcTiemsCapa + 2) = CollatzFullHorizontal(tryMin, tryTimes, culcTiemsCapa)
                
End Sub

'計算過程:列方向へ出力
Function CollatzFullHorizontal( _
    ByVal tryMin As Variant, _
    ByVal tryTimes As Long, _
    ByVal culcTiemsCapa As Long) _
    As Variant
    
    Dim tryMax As Variant: tryMax = tryMin + tryTimes - 1
    ReDim arr(tryTimes - 1, culcTiemsCapa + 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
        col = 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
            col = col + 1
            arr(row, col) = n
        Loop
        arr(row, 0) = col - 1 & "回"
        'このループはスピルで使用する場合はあった方が良い。スピルで使用しない場合はなくても良い
        For j = col + 1 To culcTiemsCapa + 1
            arr(row, j) = ""
        Next
        '--------------------------------------------
        row = row + 1
    Next
    CollatzFullHorizontal = arr
End Function


Don't you submit code?
Submit