☰

首次满足条件时，按升序将垂直范围内的值分配给另一个单元格，然后退出

tag-icon • tag-icon microsoft-excel vba
首次满足条件时，按升序将垂直范围内的值分配给另一个单元格，然后退出

我不确定我是否做得正确，但我试图编写一个子程序，查找符合我的条件的第一个值，然后将其复制到另一个单元格，然后停止查找任何其他值。

具体来说，我有一个按升序排列的 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 编程。

答案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

相关内容