☰

Присвоить значение из вертикального диапазона в порядке возрастания другой ячейке в первый раз, когда критерий выполнен, затем выйти

tag-icon • tag-icon microsoft-excel vba
Присвоить значение из вертикального диапазона в порядке возрастания другой ячейке в первый раз, когда критерий выполнен, затем выйти

Я не уверен, что делаю это правильно, но я пытаюсь написать подпрограмму, которая ищет первое значение, соответствующее моим критериям, затем копирует его в другую ячейку, а затем прекращает поиск других значений.

Если говорить точнее, у меня есть столбец из 18 месяцев в порядке возрастания (от самых старых к самым новым), и я сравниваю его с сегодняшней датой.

  • 1 сентября 2019 г.
  • 1 октября 2019 г.
  • 1 ноября 2019 г.
  • 1 декабря 2019 г.
  • 1 января 2020 г.
  • 1 февраля 2020 г.
  • 1 марта 2020 г.
  • 1 апреля 2020 г.
  • 1 мая 2020 г.
  • 1 июня 2020 г.
  • 1 июля 2020 г.
  • 1 августа 2020 г.
  • 1 сентября 2020 г.
  • 1 октября 2020 г.
  • 1 ноября 2020 г.
  • 1 декабря 2020 г.
  • 1 января 2021 г.
  • 1 февраля 2021 г.

Затем я хочу, чтобы первый месяц после сегодняшней даты был скопирован в другую ячейку, а затем макрос прекратил поиск дополнительных значений, соответствующих этому критерию.

Вот как сейчас выглядит мой код.

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

Связанный контент