Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Berechnungen für Bereich, falls Kriterium erfüllt

Betrifft: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 10.11.2014 12:00:38

Hallo zusammen,
ich bräuchte dringend Eure Hilfe!

Ich schreibe eine Funktion mit 3 Eingangsparameter: einem Startzeitpunkt Z1 (Datum), einem Endzeitpunkt Z2 (Datum) und einer dritten Variable B (Zahl).
Der Startzeitpunkt befindet sich in Spalte C, der Endzeitpunkt in Spalte H und die dritte Variable in Spalte D in einer Tabelle in Tabellenblatt 9.
Die Zeilen dieses Tabellenblatts sind zunächst nach dem Startzeitpunkt und schließlich nach der dritten Variable aufsteigend sortiert.
Der "indirekt gesuchte" Wert befindet sich in Spalte M:
Es sollen nun vorerst insgesamt 4 Werte (aus Spalte M) gesucht und als Variablen (A, B, C, D) abgespeichert werden, mit denen dann in der Funktion weitere Berechnungen angestellt werden können:

A: Wert aus Spalte M aus der Zeile, die folgende Kriterien erfüllt:
Z1 entspricht exakt Spalte C, Z2 entpricht möglichst Spalte H (sonst: nächstbester Wert darunter), B entspricht möglichst Spalte D (sonst: nächstbester Wert darunter)

B: Wert aus Spalte M aus der Zeile, die folgende Kriterien erfüllt:
Z1 entspricht exakt Spalte C, Z2 entpricht möglichst Spalte H (sonst: nächstbester Wert darunter), B entspricht möglichst Spalte D (sonst: nächstbester Wert darüber)

C: Wert aus Spalte M aus der Zeile, die folgende Kriterien erfüllt:
Z1 entspricht exakt Spalte C, Z2 entpricht möglichst Spalte H (sonst: nächstbester Wert darüber), B entspricht möglichst Spalte D (sonst: nächstbester Wert darunter)

D: Wert aus Spalte M aus der Zeile, die folgende Kriterien erfüllt:
Z1 entspricht exakt Spalte C, Z2 entpricht möglichst Spalte H (sonst: nächstbester Wert darüber), B entspricht möglichst Spalte D (sonst: nächstbester Wert darüber).

Vielen Dank für Eure Hilfe!

  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 10.11.2014 16:27:32

Hi,

hätte nun folgenden Code geschrieben, bekomme aber die Fehlermeldung #WERT! (Vorerst nur beispielhaft für "A" (siehe oben)!)

Function Test(ByVal Z1 As Date, _
                ByVal Z2 As Date, _
                ByVal B As Double) As Double
    
    Dim Zelle As Range
    Dim Start As String
    Dim A As Double
    Dim Z_alt As Date
    Dim B_alt As Double
    
    With Worksheets("Tabelle1")
        
    'Gleiches Datum suchen
    Set Zelle = .Columns(3).Find(T1, lookat:=xlWhole, LookIn:=xlFormulas)
    Start = Zelle.Address
        
    'Initialisierung
    Z_alt = .Cells(Zelle.Row, 8)
    B_alt = .Cells(Zelle.Row, 4)
    A = .Cells(Zelle.Row, 13)
    
    If Not Zelle Is Nothing Then
        
        Do
        
        
        If DateDiff("y", .Cells(Zelle.Row, 8), Z2) >= 0 And DateDiff("y", Z_alt, .Cells(Zelle. _
Row, 8)) >= 0 Then
            
            
            If .Cells(Zelle.Row, 4) <= B And .Cells(Zelle.Row, 4) - B_alt > 0 Then
                
            
            A = .Cells(Zelle.Row, 13)
            Z_alt = .Cells(Zelle.Row, 8)
            B_alt = .Cells(Zelle.Row, 4)
                
                ' Falls identisches zweites Datum und identische Zahl, Schleife verlassen!
                If DateDiff("d", .Cells(Zelle.Row, 8), Z2) = 0 And .Cells(Zelle.Row, 4) = B  _
Then
                Exit Do
                End If
            End If
        End If
            
        ' Nächsten Treffer mit selbem Datum suchen:
        Set Zelle = .Columns(3).FindNext(Zelle)
        Loop While Not Zelle Is Nothing And Zelle.Address <> Start
        
    
    Test = A
    
    Else
        Test = "Fehler"
        
    End If
    
    End With
    
End Function

Kann mit jemand weiterhelfen?


  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Rudi Maintaire
Geschrieben am: 10.11.2014 16:44:45

Hallo,
warum T1?
Set Zelle = .Columns(3).Find(T1, lookat:=xlWhole, LookIn:=xlFormulas)

Gruß
Rudi


  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 10.11.2014 16:58:41

Ouh, Tippfehler...muss natürlich Z1 lauten...funktioniert trotzdem nicht...


  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 10.11.2014 17:48:15

Dennoch danke für den Hinweis, Rudi...wie gesagt, klappt trotzdem (noch) nicht...


  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 11.11.2014 20:13:42

Nachdem ich nun Z1 als String dimensioniert habe und LookIn:=xlFormulas durch Lookin:=xlValues ersetzt habe, läuft zumindest:

Set Zelle = .Columns(3).Find(T1, lookat:=xlWhole, LookIn:=xlValues)

Allerdings taucht immer noch der Fehler #WERT! auf.
Der Fehler muss also irgendwo in der Do-Schleife liegen...kann mir jemand weiterhelfen?

Function Test(ByVal Z1 As Date, _
                  ByVal Z2 As Date, _
                  ByVal B As Double) As Double
      
      Dim Zelle As Range
      Dim Start As String
      Dim A As Double
      Dim Z_alt As Date
      Dim B_alt As Double
      
      With Worksheets("Tabelle1")
          
      'Gleiches Datum suchen
      Set Zelle = .Columns(3).Find(Z1, lookat:=xlWhole, LookIn:=xlFormulas)
      Start = Zelle.Address
          
      'Initialisierung
      Z_alt = .Cells(Zelle.Row, 8)
      B_alt = .Cells(Zelle.Row, 4)
      A = .Cells(Zelle.Row, 13)
      
      If Not Zelle Is Nothing Then
          
          Do
          
          
          If DateDiff("y", .Cells(Zelle.Row, 8), Z2) >= 0 And DateDiff("y", Z_alt, .Cells(Zelle. _
Row, 8)) >= 0 Then
              
              
              If .Cells(Zelle.Row, 4) <= B And .Cells(Zelle.Row, 4) > B_alt Then
                  
              
              A = .Cells(Zelle.Row, 13)
              Z_alt = .Cells(Zelle.Row, 8)
              B_alt = .Cells(Zelle.Row, 4)
                  
                  ' Falls identisches zweites Datum und identische Zahl, Schleife verlassen!
                  If DateDiff("d", .Cells(Zelle.Row, 8), Z2) = 0 And .Cells(Zelle.Row, 4) = B   _
Then
                  Exit Do
                  End If
              End If
          End If
              
          ' Nächsten Treffer mit selbem Datum suchen:
          Set Zelle = .Columns(3).FindNext(Zelle)
          Loop While Not Zelle Is Nothing And Zelle.Address <> Start
          
      
      Test = A
          
      End If
      
      End With
      
  End Function



  

Betrifft: AW: Berechnungen für Bereich, falls Kriterium erfüllt von: Florian Müller
Geschrieben am: 12.11.2014 09:33:22

Habe gestern den falschen Code hochgeladen, hier der richtige (vorher war Z1 nicht als String dimensioniert): Wie gesagt, der Code läuft immer noch nicht...

Function Test(ByVal Z1 As String, _
                  ByVal Z2 As Date, _
                  ByVal B As Double) As Double
      
      Dim Zelle As Range
      Dim Start As String
      Dim A As Double
      Dim Z_alt As Date
      Dim B_alt As Double
      
      With Worksheets("Tabelle1")
          
      'Gleiches Datum suchen
      Set Zelle = .Columns(3).Find(Z1, lookat:=xlWhole, LookIn:=xlFormulas)
      Start = Zelle.Address
          
      'Initialisierung
      Z_alt = .Cells(Zelle.Row, 8)
      B_alt = .Cells(Zelle.Row, 4)
      A = .Cells(Zelle.Row, 13)
      
      If Not Zelle Is Nothing Then
          
          Do
          
          
          If DateDiff("y", .Cells(Zelle.Row, 8), Z2) >= 0 And DateDiff("y", Z_alt, .Cells(Zelle. _
Row, 8)) >= 0 Then
              
              
              If .Cells(Zelle.Row, 4) <= B And .Cells(Zelle.Row, 4) > B_alt Then
                  
              
              A = .Cells(Zelle.Row, 13)
              Z_alt = .Cells(Zelle.Row, 8)
              B_alt = .Cells(Zelle.Row, 4)
                  
                  ' Falls identisches zweites Datum und identische Zahl, Schleife verlassen!
                  If DateDiff("d", .Cells(Zelle.Row, 8), Z2) = 0 And .Cells(Zelle.Row, 4) = B  _
Then
                  Exit Do
                  End If
              End If
          End If
              
          ' Nächsten Treffer mit selbem Datum suchen:
          Set Zelle = .Columns(3).FindNext(Zelle)
          Loop While Not Zelle Is Nothing And Zelle.Address <> Start
          
      
      Test = A
          
      End If
      
      End With
      
  End Function



 

Beiträge aus den Excel-Beispielen zum Thema "Berechnungen für Bereich, falls Kriterium erfüllt"