Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Max bei Match mit mehreren Kriterien und Treff

VBA Max bei Match mit mehreren Kriterien und Treff
24.01.2017 15:05:38
Matthias
Hey liebe Excel und VBA Experten,
ich hab eine Excel zusammengebastelt und diese braucht mittlerweile leider Ewigkeiten zum rechnen... daher will ich diese jetz mit VBA etwas verbesser :) Problem ich habe keinen Dunst von VBA und versuche mich anhand von Foren und Büchern durchzuschlagen - dabei kommm ich leider schnell an meine Grenzen - ich hoffe ihr könnt mir helfen!
Was ist mein Ziel: Ich will eine Formel schreiben die über einige Tausend Zeilen arbeitet. _ Dabei soll aus diesem Datensatz nach 2 Kriterien abgeglichen werden, wobei das eine Kriterium konstant bleibt ("TEXT") und das andere von 100 bis 100+N (nicht lückenlos) geht [sprich eine schleife]. Dabei können Treffer jedoch doppelt vorkommen und es soll daher der MAX-Wert genommen werden (letzte Zeile in der der Wert gefunden wurde). Tja soweit schaffe ich es leider noch nicht mal das Ganze zu schreiben (siehe Ansatz) und es geht noch weiter... Das Ganze muss noch ein zweites mal durchgeführt werden wobei jetzt das zweite Kriterium (zuvor "TEXT" jetzt "TEXT2" heißt) jetzt anders ist. Zwischen diesen Zeilen soll nun die Summe gebildet werden.... Ich hoffe es ist etwas verständlich

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

Aufbau Tabellenblatt Referenznummern:
RefNr.
100
101
103
106...
Aufbau Tabellenblatt Datensatz (ohne Leerzeilen):
RefNr.___2. Krit___Summenbereich
100________TEXT________1
100________aaaa________6
100________aaaa________#
100________TEXT________#....
100________TEXT2
101________aaaa
103________TEXT
103________aaaa
103________TEXT2
Mir wäre schon viel geholfen wenn jmd. weiß wie ich es hinbekomme das mir die Max Zeile ausgespuckt wird und nicht die Erste wo er das Kriterium findet! Derzeit würde der Code klappen um die Zeile des 1. Matches für jede RefNr zu bekommen (wenn RefNrsDat As Range definiert wird)
Schonmal Danke
Grüße Matthias

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Max bei Match mit mehreren Kriterien und Treff
24.01.2017 18:25:50
Dieter
Hallo Matthias,
ich verstehe dein Problem so, dass du eine Funktion haben willst, die du im Blatt "Referenznummern" einsetzen kannst und die dir zu jeder Referenznummer die Summe der beiden jeweils maximalen Zeilennummern gibt, in denen "TEXT" bzw. "TEXT2" steht.
Wenn das so ist, dann kannst du das mit dem folgenden Programm machen:

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

Die Funktion kannst du im Blatt "Referenznummer" genauso nutzen, wie eine normale Excel-Funktion.
Ich füge meine Arbeitsmappe zur Demonstration bei.
https://www.herber.de/bbs/user/110846.xlsm
Falls du etwas anderes im Sinn hattest, müsstest du ein paar weitere Erläuterungen schreiben. Am besten eine Beispielmappe hochladen.
Viele Grüße
Dieter
Anzeige
AW: VBA Max bei Match mit mehreren Kriterien und Treff
24.01.2017 18:38:30
Dieter
Hallo Matthias,
ich hab gerade gesehen, dass ich dir die falsche (unfertige) Datei geschickt habe.
Jetzt hoffentlich die richtige:
https://www.herber.de/bbs/user/110848.xlsm
Viele Grüße
Dieter
AW: VBA Max bei Match mit mehreren Kriterien und Treff
26.01.2017 09:49:12
Matthias
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
Anzeige
AW: VBA Max bei Match mit mehreren Kriterien und Treff
26.01.2017 10:35:31
Matthias
Hey
also mein Gedanke war das evtl. wie folgt einzubauen...

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
leider klappt der Code nicht... Hoffe mein Gedanke war nicht völlig falsch?
Gruß
Matthias
Anzeige
AW: VBA Max bei Match mit mehreren Kriterien und Treff
26.01.2017 21:23:26
Dieter
Hallo Matthias,
du hast da direkt eine Menge Fragen. Wir sollten das schrittweise angehen.
1. Zuerst eine kurze Erläuterung zu "NOT maxGefunden(i)". Es wird ja im Tabellenblatt von unten nach oben gesucht und in jeder Zeile wird geprüft, ob Krit(1) oder Krit(2) erfüllt ist. maxGefunden(i) hat für i = 1 und i = 2 am Anfang den Wert False. Wenn in der Schleife zum ersten Mal Krit(i) angetroffen wird, dann handelt es sich – da von unten aus gesucht wird – um die maximale Zeile mit diesem Kriterium. Daher wird die entsprechende Zeile in zeileMax(i) festgehalten und die boolesche Variable maxGefunden(i) wird auf True gesetzt. Damit wird verhindert, dass bei einem erneuten Auffinden des Kriteriums die zugehörige Zeile als maximale Zeile bestimmt wird.
2. Deine nächste Frage verstehe ich so, dass du gar nicht zu jeder einzelnen Referenznummer den Funktionswert haben willst, sondern nur die Summe über alle Funktionswerte brauchst.
Wenn wir jetzt bei der einmal geschriebenen Funktion bleiben, dann könntest du die Summe folgendermaßen ausrechnen (Es wäre noch zu pfüfen, ob es richtig ist, dass die Funktion "MaxZeile" einen Long-Wert zurück gibt, oder ob das nicht ein Double-Wert sein sollte):
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

Natürlich lässt sich die Summation genauso mit deiner Funktion machen, die um die beiden Parameter Ber1 und Ber2 erweitert ist.
Leider ist mir nicht klar geworden, was du in dem Programm aus deiner zweiten Nachricht machen willst.
Vielleicht willst du das, was mein Programm "Summation" macht, direkt mit der Funktion zusammenfassen.
Das wäre natürlich grundsätzlich machbar, bringt aber nicht sehr viel Zeitersparnis.
Wenn wir die vorliegende Summation einvernehmlich geklärt haben, können wir gern darüber reden. Ebenso auch über weitere Suchmöglichkeiten, seinen es weitere Suchkriterien oder unterschiedliche Suchrichtungen. Allerdings werde ich morgen kaum dazu kommen, aber sehr wahrscheinlich am Wochenende.
Viele Grüße
Dieter
Anzeige

338 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige