プロシージャが大きすぎます

プログラムが大きいとエラー。64Kを超えるとダメとのこと。

8,000行くらい書いて実行したら上記のエラーが出ました。

Sub test()
    
    Dim iYear As Integer, iMonth As Integer, iDay As Integer
    Dim sMsg As String
    
    'テストデータ
    iYear = 2023
    iMonth = 2
    iDay = 30
    
    If iYear = 2022 And iMonth = 1 And iDay = 1 Then
        sMsg = "2022年1月1日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 2 Then
        sMsg = "2022年1月2日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 3 Then
        sMsg = "2022年1月3日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 4 Then
        sMsg = "2022年1月4日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 5 Then
        sMsg = "2022年1月5日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 6 Then
        sMsg = "2022年1月6日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 7 Then
        sMsg = "2022年1月7日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 8 Then
        sMsg = "2022年1月8日"
    
    '～略～
    
    ElseIf iYear = 2032 And iMonth = 12 And iDay = 30 Then
        sMsg = "2032年12月30日"
    ElseIf iYear = 2032 And iMonth = 12 And iDay = 31 Then
        sMsg = "2032年12月31日"
    Else
        sMsg = "日付が不正です"
    End If
    
    Debug.Print sMsg
    
End Sub

コンパイルエラーが起きなくなるまでIF文の分岐を下から削除。
このラインでエラーが出なくなり、約3,500行残った。削除せずにコメントアウトでもOK。

ダメなポイント
・3,500行も書いて日付範囲が5年弱。
・別プロシージャを追加すれば日付範囲が広げられる？
・プロシージャの64K制限をどうにかすれば・・・
・改修の作業量が尋常じゃない。
・違う。そうじゃない。

上記プログラムを出力したプログラムも載せときます。

'新規シートに出力される。VBEにコピペしてインデント揃える。
Sub プログラムを出力するプログラム()
    
    Dim iYear As Integer, iMonth As Integer, iDay As Integer
    Dim sMsg As String
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets.Add
    
    Dim iRow As Long: iRow = 1
    
    For iYear = Year(Now()) To Year(Now()) + 10
        For iMonth = 1 To 12
            For iDay = 1 To 31
                
                '月またぎ判定。うるう年対応。
                If Not IsDate(iYear & "/" & iMonth & "/" & iDay) Then Exit For
                
                sh.Range("A" & iRow).Value = "elseif iYear = " & iYear & " and iMonth = " & iMonth & " and iDay = " & iDay & " then"
                sh.Range("B" & iRow + 1).Value = "sMsg = """ & iYear & "年" & iMonth & "月" & iDay & "日"""
                
                iRow = iRow + 2
                
            Next
        Next
    Next
    sh.Range("A" & iRow).Value = "end if"
    sh.Range("A1").Value = Replace(sh.Range("A1").Value, "elseif", "if") '最初のelseifを修正
    
    Set sh = Nothing
    
End Sub

以上。