S_りゅうりゅうさん課題

Option Explicit

'S_りゅうりゅうさん課題     ・・・元場所：VBAProject.Module1
'S_りゅうりゅうさん課題用2  ・・・元場所：VBAProject.Module1
'S_りゅうりゅうさん課題用1  ・・・元場所：VBAProject.Module1
'S_りゅうりゅうさん課題用3  ・・・元場所：VBAProject.Module1
'S_りゅうりゅうさん課題用4  ・・・元場所：VBAProject.Module1
'ConvStrArray1DLong         ・・・元場所：VBAProject.Module1
'ShowValueArray1D           ・・・元場所：VBAProject.Module1
'ClipText                   ・・・元場所：IkiAddin.ModClipboard
'AddArray1DValue            ・・・元場所：VBAProject.Module1
'SubtractionArray1DValue    ・・・元場所：VBAProject.Module1
'MultArray1DValue           ・・・元場所：VBAProject.Module1
'MultValue1_9Array1DValue   ・・・元場所：VBAProject.Module1
'MultValue10Array1DValue    ・・・元場所：VBAProject.Module1
'DivideArray1DValue         ・・・元場所：VBAProject.Module1
'CompareArray1DValue        ・・・元場所：VBAProject.Module1
'ConvArray1DValue_Left0Empty・・・元場所：VBAProject.Module1

Public Sub S_りゅうりゅうさん課題()
    Call S_りゅうりゅうさん課題用1
    Debug.Print
    
    Call S_りゅうりゅうさん課題用2
    Debug.Print
    
    Call S_りゅうりゅうさん課題用3
    Debug.Print
    
    Call S_りゅうりゅうさん課題用4
End Sub

Private Sub S_りゅうりゅうさん課題用1()
    '値を文字列型で生成
    Dim StrValue1 As String: StrValue1 = "15237468517234346287"
    Dim StrValue2 As String: StrValue2 = "5843521453"
    
    '一次元配列に変換
    Dim ValueArray1() As Long: ValueArray1 = ConvStrArray1DLong(StrValue1)
    Dim ValueArray2() As Long: ValueArray2 = ConvStrArray1DLong(StrValue2)
    
    '表示確認
    ShowValueArray1D ValueArray1, "X"
    ShowValueArray1D ValueArray2, "Y"
    
    '加算
    Dim Output() As Long
    Output = AddArray1DValue(ValueArray1, ValueArray2)
    
    ShowValueArray1D Output, "X+Y"
    
End Sub

Private Sub S_りゅうりゅうさん課題用2()
    '値を文字列型で生成
    Dim StrValue1 As String: StrValue1 = "15237468517234346287"
    Dim StrValue2 As String: StrValue2 = "5843521453"
    
    '一次元配列に変換
    Dim ValueArray1() As Long: ValueArray1 = ConvStrArray1DLong(StrValue1)
    Dim ValueArray2() As Long: ValueArray2 = ConvStrArray1DLong(StrValue2)
    
    '表示確認
    ShowValueArray1D ValueArray1, "X"
    ShowValueArray1D ValueArray2, "Y"
    
    '減算
    Dim Output() As Long
    Output = SubtractionArray1DValue(ValueArray1, ValueArray2)
    ShowValueArray1D Output, "X-Y"
    
End Sub

Private Sub S_りゅうりゅうさん課題用3()
    '値を文字列型で生成
    Dim StrValue1 As String: StrValue1 = "15237468517234346287"
    Dim StrValue2 As String: StrValue2 = "1234"
    
    '一次元配列に変換
    Dim ValueArray1() As Long: ValueArray1 = ConvStrArray1DLong(StrValue1)
    Dim ValueArray2() As Long: ValueArray2 = ConvStrArray1DLong(StrValue2)
    
    '表示確認
    ShowValueArray1D ValueArray1, "X"
    ShowValueArray1D ValueArray2, "Y"
    
    '掛け算
    Dim Output() As Long
    Output = MultArray1DValue(ValueArray1, ValueArray2)
    ShowValueArray1D Output, "X*Y"
    
End Sub

Private Sub S_りゅうりゅうさん課題用4()
    '値を文字列型で生成
    Dim StrValue1 As String: StrValue1 = "15237468517234346287"
    Dim StrValue2 As String: StrValue2 = "1234"
    
    '一次元配列に変換
    Dim ValueArray1() As Long: ValueArray1 = ConvStrArray1DLong(StrValue1)
    Dim ValueArray2() As Long: ValueArray2 = ConvStrArray1DLong(StrValue2)
    
    '表示確認
    ShowValueArray1D ValueArray1, "X"
    ShowValueArray1D ValueArray2, "Y"
    
    '割り算
    Dim Output As Variant
    Output = DivideArray1DValue(ValueArray1, ValueArray2)
    Dim ValueArray_Quotient()  As Long: ValueArray_Quotient = Output(1)
    Dim ValueArray_Remainder() As Long: ValueArray_Remainder = Output(2)
    ShowValueArray1D ValueArray_Quotient, "商"
    ShowValueArray1D ValueArray_Remainder, "余"
    
    '計算結果確認
    ShowValueArray1D AddArray1DValue(ValueArray_Remainder, MultArray1DValue(ValueArray_Quotient, ValueArray2)), "Y*商+余"
    
End Sub

Private Function ConvStrArray1DLong(Str As String) As Long()
    Dim N        As Long: N = Len(Str)
    Dim Output() As Long: ReDim Output(1 To N)
    Dim I        As Long
    For I = 1 To N
        Output(N - I + 1) = Mid(Str, I, 1)
    Next
    ConvStrArray1DLong = Output
End Function

Private Sub ShowValueArray1D(ValueArray1D() As Long, Optional Str As String = "")
    Dim Output As String
    Dim I As Long
    For I = UBound(ValueArray1D, 1) To 1 Step -1
        Output = Output & ValueArray1D(I)
    Next
    
    If Str <> "" Then
        Debug.Print Str, Output
    Else
        Debug.Print Output
        Call ClipText(Output)
    End If
End Sub

Private Sub ClipText(ByVal Text As Variant)
'テキストをクリップボードに格納
'テキストが配列ならば列方向をTab区切り、行方向を改行
'https://www.softex-celware.com/post/cliptext

'引数
'Text・・・クリップボードに格納するテキスト
'          文字列、一次元配列、二次元配列に対応
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※
    '引数処理
    '入力した引数が文字列、一次元配列、二次元配列のどれかを判定
    Dim Dimension  As Long
    Dim Dummy      As Long
    If IsArray(Text) = False Then '配列でない場合
        Dimension = 0
    Else '配列の場合
        On Error Resume Next
        Dummy = UBound(Text, 2)
        On Error GoTo 0
        If Dummy = 0 Then
            Dimension = 1 '一次元配列と判定
        Else
            Dimension = 2 '二次元配列と判定
        End If
    End If
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※
    '処理
    'クリップボードに格納用のテキスト変数を作成
    Dim Output As String
    Dim I      As Long
    Dim J      As Long
    
    If Dimension = 0 Then
        '文字列の場合
        Output = Text
        
    ElseIf Dimension = 1 Then
        '一次元配列の場合
        Output = ""
        For I = LBound(Text, 1) To UBound(Text, 1)
            If I = LBound(Text, 1) Then
                Output = Text(I)
            Else
                Output = Output & vbCrLf & Text(I)
            End If
        Next I
        
    ElseIf Dimension = 2 Then
        '二次元配列の場合
        Output = ""
        For I = LBound(Text, 1) To UBound(Text, 1)
            For J = LBound(Text, 2) To UBound(Text, 2)
                If J < UBound(Text, 2) Then
                    '列方向Tab区切り
                    Output = Output & Text(I, J) & Chr(9)
                Else
                    Output = Output & Text(I, J)
                End If
            Next J
            
            If I < UBound(Text, 1) Then
                '行方向を改行
                Output = Output & vbCrLf
            End If
        Next I
    End If
    
    'クリップボードに格納
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .Text = Output
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With
    
End Sub

Private Function AddArray1DValue(ValueArray1() As Long, ValueArray2() As Long) As Long()
'2つの0～9の値が入った一次元配列を加算する。
'一次元配列の要素番号が桁数に該当し、大きな数をあらわす。
'20230420
    
    '要素数を取得する
    Dim N1   As Long: N1 = UBound(ValueArray1, 1)
    Dim N2   As Long: N2 = UBound(ValueArray2, 1)
    Dim MaxN As Long: MaxN = WorksheetFunction.Max(N1, N2)
    
    '2つの一次元配列を同じ要素数にする
    If N1 < N2 Then
        ReDim Preserve ValueArray1(1 To MaxN)
    ElseIf N1 > N2 Then
        ReDim Preserve ValueArray2(1 To MaxN)
    End If
    
    '配列の準備
    Dim Output() As Long: ReDim Output(1 To MaxN) 'まずは最大要素分用意する
    Dim I        As Long
    For I = 1 To MaxN
        If I < MaxN Then
            If Output(I) + ValueArray1(I) + ValueArray2(I) >= 10 Then '10を超える場合は次の位に+1
                Output(I) = Output(I) + ValueArray1(I) + ValueArray2(I) - 10
                Output(I + 1) = 1
            Else
                Output(I) = Output(I) + ValueArray1(I) + ValueArray2(I)
            End If
        Else
            If Output(I) + ValueArray1(I) + ValueArray2(I) >= 10 Then '10を超える場合は次の位に+1
                ReDim Preserve Output(1 To MaxN + 1) '桁数が1つ増える
                Output(I) = Output(I) + ValueArray1(I) + ValueArray2(I) - 10
                Output(I + 1) = 1
            Else
                Output(I) = Output(I) + ValueArray1(I) + ValueArray2(I)
            End If
        End If
    Next
        
    '出力
    AddArray1DValue = Output
    
End Function

Private Function SubtractionArray1DValue(ValueArray1() As Long, ValueArray2() As Long) As Long()
'2つの0～9の値が入った一次元配列を減算する。
'一次元配列の要素番号が桁数に該当し、大きな数をあらわす。
'20230420
    
    '要素数を取得する
    Dim N1   As Long: N1 = UBound(ValueArray1, 1)
    Dim N2   As Long: N2 = UBound(ValueArray2, 1)
    Dim MaxN As Long: MaxN = WorksheetFunction.Max(N1, N2)
    
    '2つの一次元配列を同じ要素数にする
    If N1 < N2 Then
        ReDim Preserve ValueArray1(1 To MaxN)
    ElseIf N1 > N2 Then
        ReDim Preserve ValueArray2(1 To MaxN)
    End If
    
    '大小関係を調べる
    Dim BiggerValueArray()  As Long
    Dim SmallerValueArray() As Long
    Dim I                   As Long
    Dim IsMinus             As Boolean
    For I = MaxN To 1 Step -1
        If ValueArray1(I) < ValueArray2(I) Then
            BiggerValueArray = ValueArray2
            SmallerValueArray = ValueArray1
            IsMinus = True
            Exit For
        ElseIf ValueArray1(I) > ValueArray2(I) Then
            BiggerValueArray = ValueArray1
            SmallerValueArray = ValueArray2
            IsMinus = False
            Exit For
        End If
    Next
    
    If IsEmpty(BiggerValueArray) = True Then
        ReDim SubtractionArray1DValue(1 To 1)
        Exit Function
    End If
    
    '配列の準備
    Dim Output() As Long: ReDim Output(1 To MaxN) 'まずは最大要素分用意する
    For I = 1 To MaxN
        If I < MaxN Then
            If BiggerValueArray(I) - SmallerValueArray(I) < 0 Then '0より小さくなる場合
                Output(I) = 10 + BiggerValueArray(I) - SmallerValueArray(I)
                BiggerValueArray(I + 1) = BiggerValueArray(I + 1) - 1
            Else
                Output(I) = BiggerValueArray(I) - SmallerValueArray(I)
            End If
        Else
            Output(I) = BiggerValueArray(I) - SmallerValueArray(I)
        End If
    Next
        
    '大きい桁から0の値が連続していたら除外する
    For I = MaxN To 1 Step -1
        If Output(I) = 0 Then
            ReDim Preserve Output(1 To I - 1)
        Else
            Exit For
        End If
    Next I
    
    '正負の部分は最大桁が正か負として返す
    If IsMinus = True Then
        Output(UBound(Output, 1)) = Output(UBound(Output, 1)) * -1
    End If
    
    '出力
    SubtractionArray1DValue = Output
    
End Function

Private Function MultArray1DValue(ValueArray1() As Long, ValueArray2() As Long) As Long()
'0～9の値が入った一次元配列同士を乗算する

    '要素数取得
    Dim N2 As Long: N2 = UBound(ValueArray2, 1)
    
    '計算
    Dim Output() As Long
    Dim I        As Long
    Dim Dummy()  As Long
    For I = 1 To N2
        If I = 1 Then
            Output = MultValue1_9Array1DValue(ValueArray1, ValueArray2(I))
'            ShowValueArray1D Output
        Else
            Dummy = MultValue1_9Array1DValue(ValueArray1, ValueArray2(I))
            Dummy = MultValue10Array1DValue(Dummy, I - 1) '10のべき乗倍
'            ShowValueArray1D Dummy
            Output = AddArray1DValue(Output, Dummy)
        End If
    Next
    
    '出力
    MultArray1DValue = Output

End Function

Private Function MultValue1_9Array1DValue(ValueArray() As Long, Value1_9 As Long) As Long()
'0～9の値が入った一次元配列に1桁の値を乗算する
    
    '要素数取得
    Dim N As Long: N = UBound(ValueArray, 1)
    
    '計算
    Dim Output() As Long: ReDim Output(1 To N)
    Dim I        As Long
    For I = 1 To N
        If I < N Then
            If Output(I) + ValueArray(I) * Value1_9 > 10 Then '10を超える場合は次の位に足す
                Output(I + 1) = Mid(Output(I) + ValueArray(I) * Value1_9, 1, 1)
                Output(I) = Right(Output(I) + ValueArray(I) * Value1_9, 1)
            Else
                Output(I) = Output(I) + ValueArray(I) * Value1_9
            End If
        Else
            If Output(I) + ValueArray(I) * Value1_9 > 10 Then '10を超える場合は次の位に足す
                ReDim Preserve Output(1 To N + 1)
                Output(I + 1) = Mid(Output(I) + ValueArray(I) * Value1_9, 1, 1)
                Output(I) = Right(Output(I) + ValueArray(I) * Value1_9, 1)
            Else
                Output(I) = Output(I) + ValueArray(I) * Value1_9
            End If
        End If
    Next
    
    '出力
    MultValue1_9Array1DValue = Output

End Function

Private Function MultValue10Array1DValue(ByRef ValueArray() As Long, _
                                               ByRef Digit As Long) _
                                                           As Long()
'0～9の値が入った一次元配列に10のべき乗をかける
'ValueArray = [1,2,3]、Digit = 3 → Output = [0,0,0,1,2,3]

'引数
'ValueArray()・・・0～9の値が入った一次元配列
'Digit       ・・・桁数
    
    '要素数取得
    Dim N As Long: N = UBound(ValueArray, 1)
    
    '計算
    Dim Output() As Long: ReDim Output(1 To N + Digit)
    Dim I As Long
    For I = 1 To N
        Output(Digit + I) = ValueArray(I)
    Next
    
    '出力
    MultValue10Array1DValue = Output

End Function

Private Function DivideArray1DValue(ValueArray1() As Long, ValueArray2() As Long) As Variant
'0～9の値が入った一次元配列同士を徐算する

    '要素数取得
    Dim N1 As Long: N1 = UBound(ValueArray1, 1)
    
    '計算
    Dim ValueArray_Quotient()    As Long: ReDim ValueArray_Quotient(1 To N1) '商
    Dim Judge                    As Boolean: Judge = False
    Dim I                        As Long
    Dim Dummy1()                 As Long
    Dim Dummy2()                 As Long
    Dim Num                      As Long
    Dim ValueArray1_Subtracted() As Long: ValueArray1_Subtracted = ValueArray1
    Dim SingleValueArray()       As Long: ReDim SingleValueArray(1 To 1)
    
    For I = N1 To 0 Step -1
        For Num = 1 To 10
            SingleValueArray(1) = Num
            Dummy1 = MultValue10Array1DValue(SingleValueArray, I)
            Dummy1 = MultArray1DValue(Dummy1, ValueArray2)
            If CompareArray1DValue(Dummy1, ValueArray1_Subtracted) = True Then
                If Num = 1 Then
                    '何もしない
                ElseIf Num >= 2 Then
                    SingleValueArray(1) = Num - 1
                    Dummy1 = MultValue10Array1DValue(SingleValueArray, I)
                    Dummy1 = MultArray1DValue(Dummy1, ValueArray2)
                    ValueArray_Quotient(I + 1) = Num - 1
                    If Judge = False Then 'Outputがから配列かどうかをなぜかVBAだと判定できないクソ
                        Dummy2 = Dummy1
                        Judge = True
                    Else
                        Dummy2 = AddArray1DValue(Dummy2, Dummy1)
                    End If
                    
                    ValueArray1_Subtracted = SubtractionArray1DValue(ValueArray1_Subtracted, Dummy1)
                End If
                Exit For
            End If
        Next
    Next
    
    '余りを計算
    Dim ValueArray_Remainder() As Long: ValueArray_Remainder() = ValueArray1_Subtracted
    
    ValueArray_Quotient = ConvArray1DValue_Left0Empty(ValueArray_Quotient)
    
    '出力
    Dim Output As Variant: ReDim Output(1 To 2)
    Output(1) = ValueArray_Quotient
    Output(2) = ValueArray_Remainder
    DivideArray1DValue = Output

End Function

Private Function CompareArray1DValue(ValueArray1() As Long, ValueArray2() As Long) As Boolean
'ValueArray1 > ValueArray2 ならTrueを返す
    
    Dim N1 As Long: N1 = UBound(ValueArray1, 1)
    Dim N2 As Long: N2 = UBound(ValueArray2, 1)
    
    Dim Output As Boolean
    Dim I      As Long
    Dim Num1   As Long
    Dim Num2   As Long
    
    If N1 > N2 Then
        Output = True
    ElseIf N1 < N2 Then
        Output = False
    Else
        For I = N1 To 1 Step -1
            Num1 = ValueArray1(I)
            Num2 = ValueArray2(I)
            
            If Num1 > Num2 Then
                Output = True
                Exit For
            ElseIf Num1 < Num2 Then
                Output = False
                Exit For
            End If
        Next
    End If
    
    CompareArray1DValue = Output
    
End Function

Private Function ConvArray1DValue_Left0Empty(Array1DValue() As Long) As Long()
'一次元配列で大きい桁から0が連続していたら除外する

    Dim Output() As Long: Output = Array1DValue
    Dim I        As Long
    Dim MaxN     As Long: MaxN = UBound(Array1DValue, 1)
    '大きい桁から0の値が連続していたら除外する
    For I = MaxN To 1 Step -1
        If Output(I) = 0 Then
            ReDim Preserve Output(1 To I - 1)
        Else
            Exit For
        End If
    Next I
    
    ConvArray1DValue_Left0Empty = Output
    
End Function