Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
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
02.02.2017 11:22:06
Matthias
Fortsetzung älterer Beitrag unter gleichem Namen (letzte Antwort 26.01.17) - hab es leider nicht geschafft davor wieder darauf zu antworten
@Dieter Klemke Ich möchte mich riesig für deine Hilfe bedanken!! Wirklich der Hammer auch deine Erklärung hat mir nochmal geholfen :) Ich hätte gerne eher geantwortet aber hab leider nicht jeden Tag/ Woche Zeit dafür mich dem Thema zu widmen :( Hab mich heute früh aber mal wieder dran gesetzt und daher jetzt zum Thema :)
(1) Die Schleife für die Summenbildung der Funktion funktioniert! Und ja ich dachte es wäre besser die Schleife in die Funktion zu integrieren - aber wenn das zeitlich keinen Unterschied macht dann ist es so eventuell sogar besser!
(1.1) Ich möchte jedoch zusätzlich zu der gebildeten Summe noch ausgegeben haben bei wievielen Nummern "maxGefunden(1) And maxGefunden(2) = True And zeileMax(1) (1.2) ich habe dafür die Option das nur ein Ergebnis gegeben wird wenn zeileMax(1) (2) ist es möglich den statischen Operator " (3) ich habe mich mal dran versucht Optionale Kriterien/ Suchbereiche einzufügen und einzubauen... das funktioniert leider nicht :( (per ' hab ich kommentiert wo Änderungen im code sind)
(4) Sehe ich das richtig wenn für ein Kriterium die Minimale Zeile gesucht werden soll und für das andere die Maximale, dass dann der Code gespalten werden muss und für i=1 bspw. minimiert wird indem von oben nach unten gesucht wird und für i=2 maximiert wird indem von unten nach oben gesucht wird?!
Public Function MaxZeile(RefNr As Long, Krit1 As String, Ber1 As String, Krit2 As String, Ber2   _
_
As String, Optional KritB_1 As String, Optional BerB_1 As String, Optional KritB_2 As String,  _
Optional BerB_2 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 KritB(1 To 2) As String
Dim BerB(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
KritB(1) = KritB_1 'neu
KritB(2) = KritB_2 'neu
Ber(1) = Ber1
Ber(2) = Ber2
BerB(1) = BerB_1 'neu
BerB(2) = BerB_2 'neu
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 KritB(i) Is Nothing Then 'wie drücke ich das aus, Möglichkeit das KritB für 1 oder 2   _
_
oder beide vorhanden ist
If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And _
Not maxGefunden(i) Then
zeileMax(i) = zeile
maxGefunden(i) = True
End If
ElseIf KritB(1) = vorhanden Then 'wie drücke ich das aus
If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And wsDaten.Cells(zeile, BerB(i)) = KritB(i)   _
_
And _
Not maxGefunden(i) Then
zeileMax(i) = zeile
maxGefunden(i) = True
End If
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) = True And zeileMax(1) ,"
MaxZeile = Application.WorksheetFunction.Sum(wsDaten.Range(wsDaten.Cells(zeileMax(1) + 1,   _
_
13), wsDaten.Cells(zeileMax(2), 13)))
End If
End Function
sry das es so viele Punkte sind die ich Anspreche aber hab halt leider kein VBA-Wissen und möchte verstehen was da von statten geht und es möglichst für die Zukunft lernen - evtl. gibt es ja noch eine gute Empfehlung für ein Buch für VBA? :) möglichst kostengünstig^^
Grüße Matthias

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Max bei Match mit mehreren Kriterien und Treff
03.02.2017 14:10:41
Matthias
So ich habe gestern und heute nochmal dran gesessen und folgender Code scheint jetzt zu laufen :)
Public Function MinMaxZeile(RefNr As Long, Krit1 As String, Ber1 As String, Art1 As String,  _
Krit2 As String, Ber2 As String, Art2 As String, ersteZeile As Long, letzteZeile As Long, Optional Vgl As Byte = 0, Optional Krit3 As String = "leer", Optional Ber3 As String = "leer", Optional Art3 As String = "leer", Optional Krit4 As String = "leer", Optional Ber4 As String = "leer", Optional Art4 As String = "leer", Optional VglKrit As Byte = 0) As Long
Dim i As Byte
Dim t As Byte
Dim KritGefunden(1 To 4) As Boolean
Dim EvalGefunden As Boolean
Dim wb As Workbook
Dim wsDaten As Worksheet
Dim wsRefNr As Worksheet
Dim zeile As Long
Dim ZeileKrit(1 To 4) As Long
Dim Krit(1 To 4) As String
Dim Ber(1 To 4) As String
Dim Art(1 To 4) As String
Krit(1) = Krit1
Krit(2) = Krit2
Krit(3) = Krit3
Krit(4) = Krit4
Ber(1) = Ber1
Ber(2) = Ber2
Ber(3) = Ber3
Ber(4) = Ber4
Art(1) = Art1
Art(2) = Art2
Art(3) = Art3
Art(4) = Art4
Set wb = ThisWorkbook
Set wsDaten = wb.Worksheets("Datensatz")
Set wsRefNr = wb.Worksheets("RefNrs")
If Krit4  "leer" Then
t = 4
ElseIf Krit3  "leer" Then
t = 3
Else
t = 2
End If
For i = 1 To t
If Art(i) = "min" Then 'suchen nach minimaler Zeile
For zeile = ersteZeile To letzteZeile Step 1
If wsDaten.Cells(zeile, "A") = RefNr Then
If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And _
Not KritGefunden(i) Then
ZeileKrit(i) = zeile
KritGefunden(i) = True
End If
End If
If KritGefunden(i) Then
Exit For
End If
Next zeile
ElseIf Art(i) = "max" Then 'suchen nach maximaler Zeile
For zeile = letzteZeile To ersteZeile Step -1
If wsDaten.Cells(zeile, "A") = RefNr Then
If wsDaten.Cells(zeile, Ber(i)) = Krit(i) And _
Not KritGefunden(i) Then
ZeileKrit(i) = zeile
KritGefunden(i) = True
End If
End If
If KritGefunden(i) Then
Exit For
End If
Next zeile
End If
Next i
If t = 2 Then 'impliziert kein 3./4. Kriterium zum Vgl.
If KritGefunden(1) And KritGefunden(2) = True And ZeileKrit(1) Finanzbuchhaltung (Storno)")
End If
ElseIf t = 3 Then
If Vgl = 1 Then 'beide Kriterien sind VOR dem 3. Vergleichskriterium = True
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) = True And ZeileKrit(1) Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 2 Then 'Krit1 VOR & Krit2 NACH dem 3. Vergleichskriterium = True
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) = True And ZeileKrit(1)  ZeileKrit(3) = True Then
MinMaxZeile = Application.WorksheetFunction.SumIfs(wsDaten.Range(wsDaten.Cells( _
ZeileKrit(1) + 1, 13), wsDaten.Cells(ZeileKrit(2), 13)), wsDaten.Range(wsDaten.Cells(ZeileKrit(1) + 1, 12), wsDaten.Cells(ZeileKrit(3), 12)), "Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 3 Then 'Krit1 NACH & Krit2 VOR dem 3. Vergleichskriterium = True
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) = True And ZeileKrit(1)  ZeileKrit(3) = True And ZeileKrit(2) Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 4 Then 'beide Kriterien sind NACH dem 3. Vergleichskriterium = True
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) = True And ZeileKrit(1)  ZeileKrit(3) = True And ZeileKrit(2) > ZeileKrit(3) = True Then
MinMaxZeile = Application.WorksheetFunction.SumIfs(wsDaten.Range(wsDaten.Cells( _
ZeileKrit(1), 13), wsDaten.Cells(ZeileKrit(2) + 1, 13)), wsDaten.Range(wsDaten.Cells(ZeileKrit(1), 12), wsDaten.Cells(ZeileKrit(2) + 1, 12)), "Finanzbuchhaltung (Storno)")
End If
End If
ElseIf t = 4 Then
If Vgl = 1 Then
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) And KritGefunden(4) = True  _
And ZeileKrit(3) Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 2 Then
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) And KritGefunden(4) = True  _
And ZeileKrit(3)  ZeileKrit(VglKrit) = True Then
MinMaxZeile = Application.WorksheetFunction.SumIfs(wsDaten.Range(wsDaten.Cells( _
ZeileKrit(1) + 1, 13), wsDaten.Cells(ZeileKrit(2), 13)), wsDaten.Range(wsDaten.Cells(ZeileKrit(1) + 1, 12), wsDaten.Cells(ZeileKrit(2), 12)), "Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 3 Then
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) And KritGefunden(4) = True  _
And ZeileKrit(3) > ZeileKrit(VglKrit) And ZeileKrit(4) Finanzbuchhaltung (Storno)")
End If
ElseIf Vgl = 4 Then
If KritGefunden(1) And KritGefunden(2) And KritGefunden(3) And KritGefunden(4) = True  _
And ZeileKrit(3) > ZeileKrit(VglKrit) And ZeileKrit(4) > ZeileKrit(VglKrit) = True Then
MinMaxZeile = Application.WorksheetFunction.SumIfs(wsDaten.Range(wsDaten.Cells( _
ZeileKrit(1) + 1, 13), wsDaten.Cells(ZeileKrit(2), 13)), wsDaten.Range(wsDaten.Cells(ZeileKrit(1) + 1, 12), wsDaten.Cells(ZeileKrit(2), 12)), "Finanzbuchhaltung (Storno)")
End If
End If
End If
End Function
Der Ganze untere Teil sind nur die verschiedenen möglichen Ausprägungen an Vergleichen die aufterten können (hoffe zumindest das ich jetz alle Eventualitäten die ich abbilden muss drinne hab) - die Formel bleibt dabei identisch
--> Hier wäre jetz noch die Frage für mich ob ich den Vergleichsoperator ggf. auch flexibel gestalten kann? Sodass dieser schweif unten nicht ist und das Ganze etwas eleganter und felxibler ist...
Was ich bisher noch nicht raugefunden habe ist wie kann ich jetzt zählen bei wievielen refnr dir Kriterien erfüllt werden und in die Summe mit einbezogen werden? Dabei wird bspw. wie folgt berechnet:
Sub Test()
Dim letzteZeile As Long
Dim summe As Double
Dim wsRefNr As Worksheet
Dim wsDaten As Worksheet
Dim zeile As Long
Set wsRefNr = ThisWorkbook.Worksheets("RefNrs")
Set wsDaten = ThisWorkbook.Worksheets("Datensatz")
letzteZeile = wsRefNr.Cells(wsRefNr.Rows.Count, "A").End(xlUp).Row
For zeile = 2 To letzteZeile
summe3 = summe3 + MinMaxZeile(wsRefNr.Cells(zeile, "A"), "TEXT1", "C", "max", "TEXT2", "C",  _
"min", wsRefNr.Cells(zeile, "B"), wsRefNr.Cells(zeile, "C"), 1, "TEXT3", "C", "min", "TEXT4", "C", "max", 1)
Next zeile
MsgBox "Summe = " & summe3
End Sub
Schonmal Danke im Vorhinein für die Hilfe
Anzeige
Beispieldatei?
05.02.2017 20:20:12
Michael
Hi Matthias,
mir ist das zu unübersichtlich und abstrakt, um es ohne Beispieldatei nachvollziehen zu wollen, was überhaupt der Punkt ist.
Was mir auf den ersten Blick auffällt: Du nutzt die Möglichkeit einer Function nicht völlig aus; d.h. wenn das Ding schon so allg. gehalten ist, warum übergibst Du die beiden Blattnamen (oder die Blätter als Objekt) nicht auch als Parameter?
Weiterhin machen die vielen "wsDaten" den Code unübersichtlich: das läßt sich mit einem "With" viel schöner schreiben (außerdem muß Excel dann nicht in JEDER Zeile das "wsDaten" parsen (d.h. den Code-Text auswerten) und zuweisen, sondern "hat das Objekt dann gleich im Fokus".
Allgemein möchte ich auf die Möglichkeit hinweisen, die vier Booleans als Zahl auszudrücken ...
(so ähnlich wie das manche Excel-Funktionen machen, z.B. Dir, siehe:
https://www.herber.de/mailing/vb/html/vafctdir.htm
und da ab "Einstellungen": vbNormal = 0 bis VbSystem = 4:
zur Illustration Datei anbei: https://www.herber.de/bbs/user/111229.xlsx
)
... wodurch die vielen Ifs sich schöner schreiben lassen.
Eine weitere Möglichkeit wäre, die Parameter zusammenzufassen in die, die es immer gibt (Zeile von/bis usw.) und die, die variabel sind: je Krit, Bereich & Art, wobei letztere als Array mit 1 bis (je nach dem) vier Zeilen am Stück übergeben werden: dadurch würde man sich (in der Funktion) das Zusammensetzen der Arrays sparen.
Hier eine Verdeutlichung, wie es gemeint ist mit vorher/nachher:
Option Explicit
' global definiert spart bei vielen Datensätzen das Übergeben des Arrays aParam:
Dim aParam
Public Function VORHER(RefNr As Long, _
Krit1 As String, Ber1 As String, Art1 As String, _
Krit2 As String, Ber2 As String, Art2 As String, _
ersteZeile As Long, letzteZeile As Long, Optional Vgl As Byte = 0, _
Optional Krit3 As String = "leer", Optional Ber3 As String = "leer", Optional Art3 As  _
String = "leer", _
Optional Krit4 As String = "leer", Optional Ber4 As String = "leer", Optional Art4 As  _
String = "leer", _
Optional VglKrit As Byte = 0) As Long
End Function
Public Function ZWISCHEN1(RefNr As Long, _
ersteZeile As Long, letzteZeile As Long, _
Krit1 As String, Ber1 As String, Art1 As String, _
Krit2 As String, Ber2 As String, Art2 As String, _
Optional Krit3 As String = "leer", Optional Ber3 As String = "leer", Optional Art3 As  _
String = "leer", _
Optional Krit4 As String = "leer", Optional Ber4 As String = "leer", Optional Art4 As  _
String = "leer", _
Optional Vgl As Byte = 0, Optional VglKrit As Byte = 0) As Long
End Function
Public Function Zwischen2(RefNr As Long, _
ersteZeile As Long, letzteZeile As Long, _
Krit1 As String, Ber1 As String, Art1 As String, _
Krit2 As String, Ber2 As String, Art2 As String, _
Optional Krit3 As String = "leer", Optional Ber3 As String = "leer", Optional Art3 As  _
String = "leer", _
Optional Krit4 As String = "leer", Optional Ber4 As String = "leer", Optional Art4 As  _
String = "leer", _
Optional Vgl As Byte = 0, Optional VglKrit As Byte = 0) As Long
End Function
Public Function Nachher(RefNr As Long, _
ersteZeile As Long, letzteZeile As Long, _
maxParam As Long, _
Optional Vgl As Byte = 0, Optional VglKrit As Byte = 0) As Long
Dim t As Long ' da brauchste keine Speicher mit "Byte" sparen...
' hinzugekommen ist das maxParam - oder hier direkt t nehmen
t = maxParam
' Das entfällt alles durch das globale Array ****
'    Krit1 As String, Ber1 As String, Art1 As String, _
'    Krit2 As String, Ber2 As String, Art2 As String, _
'    Optional Krit3 As String = "leer", Optional Ber3 As String = "leer", Optional Art3 As  _
String = "leer", _
'    Optional Krit4 As String = "leer", Optional Ber4 As String = "leer", Optional Art4 As  _
String = "leer", _
End Function
Sub Bla()
Dim maxP& ' & = as long
' *** vorher *******
For zeile = 2 To letzteZeile
summe3 = summe3 + VORHER(wsRefNr.Cells(zeile, "A"), _
"TEXT1", "C", "max", _
"TEXT2", "C", "min", _
wsRefNr.Cells(zeile, "B"), wsRefNr.Cells(zeile, "C"), _
1, _
"TEXT3", "C", "min", _
"TEXT4", "C", "max", _
1)
Next zeile
' *** nachher ***
ReDim aParam(1 To 3, 1 To 4)
maxP = 4 ' Du weißt ja, wieviele Parameter Du hast;
' Die Idee ist, aParam immer mit 4 Zeilen zu übergeben, aber
' die Auswertung des t in der Function durch maxP zu ersetzen
aParam(1, 1) = "Text1": aParam(1, 2) = "C": aParam(1, 3) = "max"
aParam(2, 1) = "Text2": aParam(2, 2) = "C": aParam(2, 3) = "min"
aParam(3, 1) = "Text3": aParam(3, 2) = "C": aParam(3, 3) = "min"
aParam(4, 1) = "Text4": aParam(4, 2) = "C": aParam(3, 3) = "max"
' Diese Parameter ändern sich offensichtlich NICHT von Aufruf zu Aufruf...
' aber selbst wenn, dann müßte man NUR den jeweiligen Wert ändern und
' kann die anderen stehen lassen
' *** nachher also die Schleife ***
For zeile = 2 To letzteZeile
summe3 = summe3 + Nachher(wsRefNr.Cells(zeile, "A"), _
wsRefNr.Cells(zeile, "B"), wsRefNr.Cells(zeile, "C"), _
maxP, _
1, _
1)
Next zeile
aParam = Empty ' wieder leeren, um Speicher freizugeben
End Sub
Schöne Grüße,
Michael
Anzeige
Nachtrag wg. Fehler
05.02.2017 20:46:59
Michael
Hi,
es muß natürlich in der Zeile
aParam(4, 1) = "Text4": aParam(4, 2) = "C": aParam(3, 3) = "max"

ganz rechts nicht (3,3) sondern (4,3) heißen.
Gruß,
M.

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige