unterschiedliche Ergebnisse wenn Filter Reihenfolge anders
25.05.2024 14:30:32
Fred
ich habe heute im Web ein Makro entdeckt und dieses stark geändert / angepaßt.
Das Makro filtert durchgehend und sucht "optimale Ergebnisse"
Werden die gefunden, gibt es entsprechende Einträge in IK:IN
Ich habe das Makro noch nicht durchgehend geprüft doch als erstes ist mir aufgefallen, das wenn die Reihenfolge
filterFields = Array("EA", "EB", "EC", "ED", "IB")in
filterFields = Array("IB", "EA", "EB", "EC", "ED")Warum ist das so?
Kann ein Experte bitte mal dieses Makro sich genau anschauen und mich auf "eventuelle Fehler" aufmerksam machen?!
Das Beispiel:
https://www.herber.de/bbs/user/169702.xlsb
Das Makro:
Sub Filter_2x()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Scalping")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Sheets("Scalping").Range("IK7:IN" & lastRow).ClearContents
Dim operators As Variant
operators = Array(">", ">=", "=")
Dim filterFields As Variant
filterFields = Array("EA", "EB", "EC", "ED", "IB")
Dim ikRow As Long
ikRow = 7
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long, j As Long
Dim n As Long, p As Long
Dim criteriaString As String
' Ein Filter pro Spalte
For n = LBound(filterFields) To UBound(filterFields)
For i = LBound(operators) To UBound(operators)
' Filter für die aktuelle Spalte setzen
ws.Range("A6:IG" & lastRow).AutoFilter
ws.Range("A6:IG" & lastRow).AutoFilter Field:=ws.Range(filterFields(n) & "6").Column, Criteria1:=operators(i) & ws.Range(filterFields(n) & "7").Value
Dim filteredIC As Range
On Error Resume Next
Set filteredIC = ws.Range("IC7:IC" & lastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not filteredIC Is Nothing Then
Dim totalIC As Double
totalIC = Application.WorksheetFunction.Sum(filteredIC)
Dim countIC As Long
countIC = filteredIC.Count
If countIC > 0 And totalIC / countIC > 0.6 Then
criteriaString = filterFields(n) & operators(i) & ws.Range(filterFields(n) & "7").Value
ws.Cells(ikRow, "IK").Value = criteriaString
ws.Cells(ikRow, "IL").Value = totalIC / countIC
ws.Cells(ikRow, "IM").Value = totalIC
ws.Cells(ikRow, "IN").Value = countIC
ikRow = ikRow + 1
End If
End If
' Filter zurücksetzen
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
Next i
For p = n + 1 To UBound(filterFields)
For i = LBound(operators) To UBound(operators)
For j = LBound(operators) To UBound(operators)
' Filter für die aktuellen zwei Spalten setzen
ws.Range("A6:IG" & lastRow).AutoFilter
ws.Range("A6:IG" & lastRow).AutoFilter Field:=ws.Range(filterFields(n) & "6").Column, Criteria1:=operators(i) & ws.Range(filterFields(n) & "7").Value
ws.Range("A6:IG" & lastRow).AutoFilter Field:=ws.Range(filterFields(p) & "6").Column, Criteria1:=operators(j) & ws.Range(filterFields(p) & "7").Value
Dim filteredICDouble As Range
On Error Resume Next
Set filteredICDouble = ws.Range("IC7:IC" & lastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not filteredICDouble Is Nothing Then
Dim totalICDouble As Double
totalICDouble = Application.WorksheetFunction.Sum(filteredICDouble)
Dim countICDouble As Long
countICDouble = filteredICDouble.Count
If countICDouble > 0 And totalICDouble / countICDouble > 0.6 Then
criteriaString = filterFields(n) & operators(i) & ws.Range(filterFields(n) & "7").Value & _
" UND " & filterFields(p) & operators(j) & ws.Range(filterFields(p) & "7").Value
ws.Cells(ikRow, "IK").Value = criteriaString
ws.Cells(ikRow, "IL").Value = totalICDouble / countICDouble
ws.Cells(ikRow, "IM").Value = totalICDouble
ws.Cells(ikRow, "IN").Value = countICDouble
ikRow = ikRow + 1
End If
End If
' Filter zurücksetzen
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
Next j
Next i
Next p
Next n
If ikRow = 7 Then
ws.Cells(3, "IK").Value = "Negativ"
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruss
Fred
Anzeige
