☰

Weisen Sie einer anderen Zelle einen Wert aus einem vertikalen Bereich in aufsteigender Reihenfolge zu, sobald ein Kriterium erfüllt ist. Beenden Sie dann den Vorgang.

tag-icon • tag-icon microsoft-excel vba
Weisen Sie einer anderen Zelle einen Wert aus einem vertikalen Bereich in aufsteigender Reihenfolge zu, sobald ein Kriterium erfüllt ist. Beenden Sie dann den Vorgang.

Ich bin nicht sicher, ob ich das überhaupt richtig mache, aber ich versuche, eine Subroutine zu schreiben, die nach dem ersten Wert sucht, der meinen Kriterien entspricht, ihn dann in eine andere Zelle kopiert und anschließend die Suche nach weiteren Werten beendet.

Um es deutlich zu machen: Ich habe eine Spalte mit 18 Monaten in aufsteigender Reihenfolge (vom ältesten zum neuesten) und vergleiche sie mit dem heutigen Datum.

  • 1. September 2019
  • 1. Oktober 2019
  • 1. November 2019
  • 1. Dezember 2019
  • 1. Januar 2020
  • 1. Februar 2020
  • 1. März 2020
  • 1. April 2020
  • 1. Mai 2020
  • 1. Juni 2020
  • 1. Juli 2020
  • 1. August 2020
  • 1. September 2020
  • 1. Oktober 2020
  • 1. November 2020
  • 1. Dezember 2020
  • 1. Januar 2021
  • 1. Februar 2021

Dann möchte ich, dass der erste Monat nach dem heutigen Datum in eine andere Zelle kopiert wird und dass das Makro anschließend die Suche nach weiteren Werten beendet, die dieses Kriterium erfüllen.

So sieht mein Code jetzt aus.

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

Ich erhalte den Fehlercode 1004: Anwendungsdefinierter oder objektdefinierter Fehler

Ehrlich gesagt denke ich, dass ich mir darüber zu viele Gedanken mache. Ich bin neu in der VBA-Programmierung.

Antwort1

Diese Neufassung bewirkt genau das, was ich wollte. Ich habe zu viel darüber nachgedacht.

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

verwandte Informationen