VBA Max bei Match mit mehreren Kriterien und Treff

Sub Test() Dim WB As Workbook Dim Daten As Worksheet Dim wsRefNr As Worksheet Dim RefNrsDat As Variant Dim RefNrs As Range Set WB = ThisWorkbook Set wsDaten = WB.Worksheets("Datensatz") Set wsRefNr = WB.Worksheets("Referenznummern") Set DatRefNrs = wsDaten.Range("A3:A" & wsDaten.Cells(Rows.Count, 1).End(xlUp).Row) For i = wsRefNr.Cells(2, 1) To wsRefNr.Cells(wsRefNr.Cells(Rows.Count, 1).End(xlUp).Row, 1) With Application.WorksheetFunction t = .Max(.Index(DatRefNrs, .Match(i, DatRefNrs, 0), 1).Row) End With MsgBox t Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function MaxZeile(RefNr As Long, Text1 As String, Text2 As String) As Long Dim i As Long Dim letzteZeile As Long Dim maxGefunden(1 To 2) As Boolean Dim Text(1 To 2) As String Dim wb As Workbook Dim wsDaten As Worksheet Dim zeile As Long Dim zeileMax(1 To 2) As Long Text(1) = Text1 Text(2) = Text2 Set wb = ThisWorkbook Set wsDaten = wb.Worksheets("Datensatz") letzteZeile = wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row If letzteZeile = 1 Then Exit Function For zeile = letzteZeile To 2 Step -1 If wsDaten.Cells(zeile, "A") = RefNr Then For i = 1 To 2 If wsDaten.Cells(zeile, "B") = Text(i) And _ Not maxGefunden(i) Then zeileMax(i) = zeile maxGefunden(i) = True End If Next i If maxGefunden(1) And maxGefunden(2) Then Exit For End If End If Next zeile If maxGefunden(1) And maxGefunden(2) Then MaxZeile = zeileMax(1) + zeileMax(2) End If End Function

Hallo Dieter,
das ist schonmal der Hammer :)
ich hab das Ganze noch so abgewandelt das ich die Spalte in der gesucht werden soll anpassen kann :) und es soll zum Schluss nicht die Summe der Zeile gebildet werden sondern über eine andere Spalte zwischen den Zeilen - aber das klappt so jetzt auch! Hammer :) Dafür erstmal riesen DANK!!
Könntest du mir evtl. erklären wie das "NOT maxGefunden(i)" funktioniert? Ich versteh noch nicht woher der jetzt da weiß was maxgefunden ist und wie er da das maxmimum sucht - den Rest kann ich denke ich nachvollziehen :)

Public Function MaxZeile(RefNr As Long, Krit1 As String, Ber1 As String, Krit2 As String, Ber2  _
As String) As Long
Dim i As Long
Dim letzteZeile As Long
Dim maxGefunden(1 To 2) As Boolean
Dim Krit(1 To 2) As String
Dim Ber(1 To 2) As String
Dim wb As Workbook
Dim wsDaten As Worksheet
Dim zeile As Long
Dim zeileMax(1 To 2) As Long
Krit(1) = Krit1
Krit(2) = Krit2
Ber(1) = Ber1
Ber(2) = Ber2
Set wb = ThisWorkbook
Set wsDaten = wb.Worksheets("Datensatz")
letzteZeile = wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row
If letzteZeile = 1 Then Exit Function
For zeile = letzteZeile To 2 Step -1
If wsDaten.Cells(zeile, "A") = RefNr Then
For i = 1 To 2
If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And _
Not maxGefunden(i) Then
zeileMax(i) = zeile
maxGefunden(i) = True
End If
Next i
If maxGefunden(1) And maxGefunden(2) Then
Exit For
End If
End If
Next zeile
If maxGefunden(1) And maxGefunden(2) Then
MaxZeile = Application.WorksheetFunction.Sum(wsDaten.Range(wsDaten.Cells(zeileMax(1) + 1, 3) _
, wsDaten.Cells(zeileMax(2), 3)))
End If
End Function

Ich hätte jetzt noch ein weiterführende Probleme - ich bemüh mich es selbst zu machen und mach mir Gedanken etc aber meine VBA-Kentnisse sind einfach mies....
Ich würde jetzt gerne nicht im Excel über tausende Zeilen das ausrechnen lassen für jede RefNr sondern direkt die Summe über die Funktion ermitteln (dabei könnte jedoch noch ein Kriterium mitauftreten) aber der Base-Case wäre schon super... Ich weiß jetzt nicht ob es da am sinnvollsten wäre das auch per Funktion zu machen oder als Sub
Mein Gedanke war zumindest jetzt eine For to Schleife zu machen mit der Funktion die du geschrieben hast. Jetzt müsste das ja iwie aufsummiert werden und ich hab keine Ahnung wie das geht^^ Dachte an in ein Array speichern und dieses dann aufsummieren? Hoffe mein Gedankengang is nicht völlig falsch...

For i = wsRefNr.Cells(2, "A") To wsRefNr.Cells(wsRefNr.Cells(Rows.Count, 1).End(xlUp).Row, "A")
With t = MaxZeile(i, "TEXT", "TEXT2")
End With
Next i

Zu der Funktion hab ich erstmal noch eine Allgemeine Frage - ist es da auch möglich optionale eingabewerte hinzuzfügen? Beispielsweise das bei einem der zu suchenden Zeilen jetzt ein drittes Suchkriterium hinzukommt. Oder ist eine Variation von Min/Max einbaubar, also anstelle Maximieren jetzt minimieren oder von dem einen min beim anderen max - oder müsste da dann für jeden Fall eine eigene Funktion geschrieben werden?
Hoffe meine Fragen sind jetz nicht zu dumm, allgemein oder oder :) Freu mich über jede Info möchte halt auch was lernen
Grüße
Matthias

Public Function SumMaxZeil(RefNr As String, Krit1 As String, Ber1 As String, Krit2 As String, _ Ber2 As String) As Long 'geändert Dim i As Long Dim letzteZeile As Long Dim maxGefunden(1 To 2) As Boolean Dim Krit(1 To 2) As String Dim Ber(1 To 2) As String Dim wb As Workbook Dim wsDaten As Worksheet Dim wsRefNr As Worksheet 'neu Dim zeile As Long Dim zeileMax(1 To 2) As Long Krit(1) = Krit1 Krit(2) = Krit2 Ber(1) = Ber1 Ber(2) = Ber2 Set wb = ThisWorkbook Set wsDaten = wb.Worksheets("Datensatz") Set wsRefNr = wb.Worksheets("Referenznummern") 'neu letzteZeile = wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row If letzteZeile = 1 Then Exit Function For j = wsRefNr.Cells(2, RefNr) To wsRefNr.Cells(wsRefNr.Cells(Rows.Count, 1).End(xlUp).Row, _ RefNr) Step 1 'neu For zeile = letzteZeile To 2 Step -1 If wsDaten.Cells(zeile, "A") = j Then 'geändert For i = 1 To 2 If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And _ Not maxGefunden(i) Then zeileMax(i) = zeile maxGefunden(i) = True End If Next i If maxGefunden(1) And maxGefunden(2) Then Exit For End If End If Next zeile If maxGefunden(1) And maxGefunden(2) Then MaxZeile(j) = Application.WorksheetFunction.Sum(wsDaten.Range(wsDaten.Cells(zeileMax(1), 3), _ wsDaten.Cells(zeileMax(2), 3))) End If Next j 'neu SumMaxZeil = Apllication.WorksheetFunktion.Sum(MaxZeile) 'neu End Function

Sub Summation() Dim letzteZeile As Long Dim summe As Double Dim wsRefNr As Worksheet Dim zeile As Long Set wsRefNr = ThisWorkbook.Worksheets("Referenznummern") letzteZeile = wsRefNr.Cells(wsRefNr.Rows.Count, "A").End(xlUp).Row For zeile = 2 To letzteZeile summe = summe + MaxZeile(wsRefNr.Cells(zeile, "A"), "TEXT", "TEXT2") Next zeile MsgBox "Summe = " & summe End Sub

Beliebteste Forumthreads (12 Monate)

VBA Max bei Match mit mehreren Kriterien und Treff

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Max bei Match mit mehreren Kriterien und Treff

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread