anonymous No title
No License VBA
2020年12月20日
Copy Clone
Option Explicit
Public lngTrib(2)
Sub test1()
    
    Dim i As Long
    Dim j As Long
    Dim str1 As String
    Dim lngUB As Long
    Dim t As Single
    
    t = Timer
    
    Do
        '速度優先のため再帰にせず(一番古い所に新しい値を入れる)
        lngTrib(i Mod 3) = Trib(i)
        str1 = ""
        lngUB = UBound(lngTrib(i Mod 3))
        For j = 0 To lngUB
            If j = lngUB Then
                '最上位はそのまま文字列
                str1 = CStr(lngTrib(i Mod 3)(j)) & str1
            Else
                '下位は8桁
                str1 = Format(lngTrib(i Mod 3)(j), "00000000") & str1
            End If
        Next j
        
        '1000桁で抜ける
        If Len(str1) >= 1000 Then
            Debug.Print str1
            Exit Do
        End If
        i = i + 1
    Loop
    
    Debug.Print Timer - t
    
    
End Sub
Private Function Trib(n As Long) As Long()
    
    Dim lngTmp() As Long
    ReDim lngTmp(0) As Long
    If n = 0 Then
        lngTmp(0) = 0
    ElseIf n = 1 Then
        lngTmp(0) = 0
    ElseIf n = 2 Then
        lngTmp(0) = 1
    Else
        lngTmp() = ArrayPlus(lngTrib(0), lngTrib(1), lngTrib(2))
    End If
    Trib = lngTmp
    
End Function
'配列同士で足し算
Private Function ArrayPlus(ary1, ary2, ary3) As Long()
    
    Dim lngTmp() As Long
    Dim i As Long
    Dim dblTmp As Double
    Dim lngUB As Long
    
    lngUB = WorksheetFunction.Max(UBound(ary1), UBound(ary2), UBound(ary3))
    ReDim lngTmp(lngUB) As Long
    ReDim Preserve ary1(lngUB) As Long
    ReDim Preserve ary2(lngUB) As Long
    ReDim Preserve ary3(lngUB) As Long
    
    For i = 0 To lngUB
        dblTmp = ary1(i) + ary2(i) + ary3(i)

        If lngTmp(i) + dblTmp >= 100000000 Then
            lngTmp(i) = (lngTmp(i) + dblTmp) Mod 100000000
            If i = lngUB Then
                ReDim Preserve lngTmp(lngUB + 1) As Long
            End If
            lngTmp(i + 1) = (dblTmp - lngTmp(i)) / 100000000
        Else
            lngTmp(i) = lngTmp(i) + CLng(dblTmp)
        End If

    Next i
    
    ArrayPlus = lngTmp
    
End Function

Option Explicit
Public lngTrib(2)
Sub test1()
    
    Dim i As Long
    Dim j As Long
    Dim str1 As String
    Dim lngUB As Long
    Dim t As Single
    
    t = Timer
    
    Do
        '速度優先のため再帰にせず(一番古い所に新しい値を入れる)
        lngTrib(i Mod 3) = Trib(i)
        str1 = ""
        lngUB = UBound(lngTrib(i Mod 3))
        For j = 0 To lngUB
            If j = lngUB Then
                '最上位はそのまま文字列
                str1 = CStr(lngTrib(i Mod 3)(j)) & str1
            Else
                '下位は8桁
                str1 = Format(lngTrib(i Mod 3)(j), "00000000") & str1
            End If
        Next j
        
        '1000桁で抜ける
        If Len(str1) >= 1000 Then
            Debug.Print str1
            Exit Do
        End If
        i = i + 1
    Loop
    
    Debug.Print Timer - t
    
    
End Sub
Private Function Trib(n As Long) As Long()
    
    Dim lngTmp() As Long
    ReDim lngTmp(0) As Long
    If n = 0 Then
        lngTmp(0) = 0
    ElseIf n = 1 Then
        lngTmp(0) = 0
    ElseIf n = 2 Then
        lngTmp(0) = 1
    Else
        lngTmp() = ArrayPlus(lngTrib(0), lngTrib(1), lngTrib(2))
    End If
    Trib = lngTmp
    
End Function
'配列同士で足し算
Private Function ArrayPlus(ary1, ary2, ary3) As Long()
    
    Dim lngTmp() As Long
    Dim i As Long
    Dim dblTmp As Double
    Dim lngUB As Long
    
    lngUB = WorksheetFunction.Max(UBound(ary1), UBound(ary2), UBound(ary3))
    ReDim lngTmp(lngUB) As Long
    ReDim Preserve ary1(lngUB) As Long
    ReDim Preserve ary2(lngUB) As Long
    ReDim Preserve ary3(lngUB) As Long
    
    For i = 0 To lngUB
        dblTmp = ary1(i) + ary2(i) + ary3(i)

        If lngTmp(i) + dblTmp >= 100000000 Then
            lngTmp(i) = (lngTmp(i) + dblTmp) Mod 100000000
            If i = lngUB Then
                ReDim Preserve lngTmp(lngUB + 1) As Long
            End If
            lngTmp(i + 1) = (dblTmp - lngTmp(i)) / 100000000
        Else
            lngTmp(i) = lngTmp(i) + CLng(dblTmp)
        End If

    Next i
    
    ArrayPlus = lngTmp
    
End Function

No one still commented. Please first comment.