条件が満たされたときに、垂直範囲から昇順で別のセルに値を割り当て、終了する

Question

これを正しく実行できているかどうかはわかりませんが、条件を満たす最初の値を検索し、それを別のセルにコピーして、それ以上の値の検索を停止するサブルーチンを作成しようとしています。

具体的には、18 か月分の列を昇順 (古いものから新しいものへ) で表示し、それを今日の日付と比較しています。

• 2019年9月1日
• 2019年10月1日
• 2019年11月1日
• 2019年12月1日
• 2020年1月1日
• 2020年2月1日
• 2020年3月1日
• 2020年4月1日
• 2020年5月1日
• 2020年6月1日
• 2020年7月1日
• 2020年8月1日
• 2020年9月1日
• 2020年10月1日
• 2020年11月1日
• 2020年12月1日
• 2021年1月1日
• 2021年2月1日

次に、今日の日付より後の最初の月を別のセルにコピーし、マクロがこの条件を満たす値の検索を停止するようにします。

これが現時点での私のコードです。

Sub Show_remaining_months()

        Dim TodaysDate As Long 'Today's Value
        
        Dim MonthCell As Range
        Dim i As Byte
        Dim EndHere As Byte
        
        
        Dim RestoreRefStyle As Integer
        Let RestoreRefStyle = Application.ReferenceStyle
        
        
        Application.ReferenceStyle = xlR1C1
        
        
        ThisWorkbook.Worksheets("subtotalizer(r-hrs)").Activate
        
        Let TodaysDate = Worksheets("subtotalizer(r-hrs)").Range("R1C5").Value ' TodaysDate = 44012
        
        
                    
                    
                    
                Let EndHere = 23
                                                     'Range(R6C3:R23C3)
                                For Each MonthCell In Range("R6C3:R" & (EndHere) & C3)
                                        
                                        For i = 6 To EndHere ' For i = 6 To 23
                                                             ' Which later then becomes i To EndHere.
                                                                                                                                                                             
                                                   If MonthCell.Value < TodaysDate Then
                                                   'Skip
                                                   i = i + 1
                                                   'i = 6 + 1 = 7
                                                   
                                                   Else
                                                   Let Range(R3C5).Value = MonthCell.Value
                                                   'i = i + 1
                                                   EndHere = i
                                                   
                                                   End If
                                                                                                 
                                       Next i
                                
                                Next MonthCell
 
    
        Application.ReferenceStyle = RestoreRefStyle


End Sub

エラーコード1004: アプリケーション定義またはオブジェクト定義エラーが発生します

正直に言うと、私はこれについて考えすぎていると思います。私は VBA プログラミングの初心者です。

Answer 1

この書き直しはまさに私が望んでいた通りです。考えすぎでした。

Sub Show_remaining_months()


    Dim TodaysDate As Long 'Today's Value
    Dim StartDate As Range
            
    Dim MonthCell As Range
    Dim i As Byte
    Dim EndHere As Byte
        

        ThisWorkbook.Worksheets("subtotalizer(r-hrs)").Activate
        
        Let TodaysDate = Range("E1").Value
        Set CurrentStartDate = Range("E3")
        

              For Each MonthCell In Range("C6:C23")
                                        
                         If MonthCell.Value > TodaysDate Then
                            CurrentStartDate.Value = MonthCell.Value
                                    
                            Exit Sub
                                                 
                         End If
            
              Next MonthCell
 
End Sub