Frage stellen

Zeilen löschen wenn nicht identisch

408 Aufrufe
Gefragt in Tabellenkalkulation von daswasserwiesel Einsteiger_in (43 Punkte)
Hallo!

ich versuche mich an einer Auswertung.

Ich habe mehrere Zeilen die ich miteinander vergleichen möchte.
Wenn in zwei Zeilen die Zellen B,C,D übereinstimmen, dann sollen diese Zeilen bestehen bleiben.
Zeilen die in den Zellen B,C,D nicht übereinstimmen sollen gelöscht werden.

Kann mir jemand weiterhelfen ?


Viele Grüße, und vielen Dank im Voraus

18 Antworten

0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Hi nighty,

klappt wunderbar.

Es werden nun zwar alle mittelwerte, min, max berechnet.
Ich bräuchte eigendlich nur die letzten 100 Stück von unten, aber das ist reine kosmetik.

vielen dank nochmals.

Gruß vom WasserWiesel
0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Hier ist die Nervensäge schon wieder.

Ich hab was vergessen.
Dein Makro funktioniert super nur muss ich noch die Spanne berechenen, sprich:

low in spalte AF --> mittelwert-minimum(I:AC)

high in spalte AG --> maximum(I:AB)-mittelwert




Option Explicit

Sub MinMaxMit()
Dim iArray() As Variant, bereichArray() As Variant
Dim kleinerWert() As Variant, mittelWert() As Variant, groesserWert() As Variant
Dim Lzeile As Long, zaehler As Long, zaehler1 As Long, zaehler2 As Long


Dim Auswahl As Variant
Set Auswahl = Worksheets("Data")
Auswahl.Activate



With ActiveSheet
Lzeile = .Range("I" & Rows.Count).End(xlUp).Row
.Range("AC2:AE" & Lzeile) = ""
kleinerWert() = Range("AE1:AE" & Lzeile)
groesserWert() = Range("AC1:AC" & Lzeile)
mittelWert() = Range("AD1:AD" & Lzeile)
iArray() = Range("I1:I" & Lzeile)
bereichArray() = Range("I1:AB" & Lzeile)
For zaehler = 2 To UBound(iArray())
If iArray(zaehler, 1) > 0 Then
kleinerWert(zaehler, 1) = iArray(zaehler, 1)
groesserWert(zaehler, 1) = iArray(zaehler, 1)
For zaehler1 = 1 To 20
If bereichArray(zaehler, zaehler1) > 0 Then
If kleinerWert(zaehler, 1) > bereichArray(zaehler, zaehler1) Then
kleinerWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
If groesserWert(zaehler, 1) < bereichArray(zaehler, zaehler1) Then
groesserWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) + bereichArray(zaehler, zaehler1)
zaehler2 = zaehler2 + 1
End If
Next zaehler1
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) / zaehler2
End If
zaehler2 = 0
Next zaehler
.Range("AD1:AD" & Lzeile) = kleinerWert()
.Range("AE1:AE" & Lzeile) = groesserWert()
.Range("AC1:AC" & Lzeile) = mittelWert()
End With

Worksheets("Report").Activate


End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi wiesel

vielleicht so ?

gruss nighty

Option Explicit
Sub MinMaxMit()
Dim iArray() As Variant, bereichArray() As Variant
Dim kleinerWert() As Variant, mittelWert() As Variant, groesserWert() As Variant
Dim LowWert() As Variant, HighWert() As Variant
Dim Lzeile As Long, zaehler As Long, zaehler1 As Long, zaehler2 As Long
With ActiveSheet
Lzeile = .Range("I" & Rows.Count).End(xlUp).Row
.Range("AC2:AE" & Lzeile) = ""
kleinerWert() = Range("AE2:AE" & Lzeile)
groesserWert() = Range("AC2:AC" & Lzeile)
mittelWert() = Range("AD2:AD" & Lzeile)
LowWert() = Range("AF2:AF" & Lzeile)
HighWert() = Range("AG2:AG" & Lzeile)
iArray() = Range("I2:I" & Lzeile)
bereichArray() = Range("I2:AB" & Lzeile)
For zaehler = 1 To UBound(iArray())
If iArray(zaehler, 1) > 0 Then
kleinerWert(zaehler, 1) = iArray(zaehler, 1)
groesserWert(zaehler, 1) = iArray(zaehler, 1)
For zaehler1 = 1 To 20
If bereichArray(zaehler, zaehler1) > 0 Then
If kleinerWert(zaehler, 1) > bereichArray(zaehler, zaehler1) Then
kleinerWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
If groesserWert(zaehler, 1) < bereichArray(zaehler, zaehler1) Then
groesserWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) + bereichArray(zaehler, zaehler1)
zaehler2 = zaehler2 + 1
End If
Next zaehler1
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) / zaehler2
LowWert(zaehler, 1) = mittelWert(zaehler, 1) - kleinerWert(zaehler, 1)
HighWert(zaehler, 1) = groesserWert(zaehler, 1) - mittelWert(zaehler, 1)
End If
zaehler2 = 0
Next zaehler
.Range("AD2:AD" & Lzeile) = kleinerWert()
.Range("AE2:AE" & Lzeile) = groesserWert()
.Range("AC2:AC" & Lzeile) = mittelWert()
.Range("AF2:AF" & Lzeile) = LowWert()
.Range("AG2:AG" & Lzeile) = HighWert()
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all

korrigiert

gruss nighty

Option Explicit
Sub MinMaxMitLowHigh()
Dim iArray() As Variant, bereichArray() As Variant
Dim kleinerWert() As Variant, mittelWert() As Variant, groesserWert() As Variant
Dim LowWert() As Variant, HighWert() As Variant
Dim Lzeile As Long, zaehler As Long, zaehler1 As Long, zaehler2 As Long
With ActiveSheet
Lzeile = .Range("I" & Rows.Count).End(xlUp).Row
.Range("AC2:AG" & Lzeile) = ""
kleinerWert() = Range("AE2:AE" & Lzeile)
groesserWert() = Range("AC2:AC" & Lzeile)
mittelWert() = Range("AD2:AD" & Lzeile)
LowWert() = Range("AF2:AF" & Lzeile)
HighWert() = Range("AG2:AG" & Lzeile)
iArray() = Range("I2:I" & Lzeile)
bereichArray() = Range("I2:AB" & Lzeile)
For zaehler = 1 To UBound(iArray())
If iArray(zaehler, 1) > 0 Then
kleinerWert(zaehler, 1) = iArray(zaehler, 1)
groesserWert(zaehler, 1) = iArray(zaehler, 1)
For zaehler1 = 1 To 20
If bereichArray(zaehler, zaehler1) > 0 Then
If kleinerWert(zaehler, 1) > bereichArray(zaehler, zaehler1) Then
kleinerWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
If groesserWert(zaehler, 1) < bereichArray(zaehler, zaehler1) Then
groesserWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) + bereichArray(zaehler, zaehler1)
zaehler2 = zaehler2 + 1
End If
Next zaehler1
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) / zaehler2
LowWert(zaehler, 1) = mittelWert(zaehler, 1) - kleinerWert(zaehler, 1)
HighWert(zaehler, 1) = groesserWert(zaehler, 1) - mittelWert(zaehler, 1)
End If
zaehler2 = 0
Next zaehler
.Range("AD2:AD" & Lzeile) = kleinerWert()
.Range("AE2:AE" & Lzeile) = groesserWert()
.Range("AC2:AC" & Lzeile) = mittelWert()
.Range("AF2:AF" & Lzeile) = LowWert()
.Range("AG2:AG" & Lzeile) = HighWert()
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi wiesel

nur die untersten 100 werden berechnet

gruss nighty

Option Explicit
Sub MinMaxMitLowHigh()
Dim kleinerWert() As Variant, mittelWert() As Variant, groesserWert() As Variant
Dim LowWert() As Variant, HighWert() As Variant, bereichArray() As Variant
Dim Lzeile As Long, zaehler As Long, zaehler1 As Long, zaehler2 As Long, Azeile As Long
With ActiveSheet
Lzeile = .Range("I" & Rows.Count).End(xlUp).Row
If Lzeile < 102 Then
Azeile = 2
Else
Azeile = Lzeile - 100
End If
.Range("AC2" & ":AG" & Lzeile) = ""
kleinerWert() = Range("AE" & Azeile & ":AE" & Lzeile)
groesserWert() = Range("AC" & Azeile & ":AC" & Lzeile)
mittelWert() = Range("AD" & Azeile & ":AD" & Lzeile)
LowWert() = Range("AF" & Azeile & ":AF" & Lzeile)
HighWert() = Range("AG" & Azeile & ":AG" & Lzeile)
bereichArray() = Range("I" & Azeile & ":AB" & Lzeile)
For zaehler = 1 To Lzeile - Azeile + 1
If bereichArray(zaehler, 1) > 0 Then
kleinerWert(zaehler, 1) = bereichArray(zaehler, 1)
groesserWert(zaehler, 1) = bereichArray(zaehler, 1)
For zaehler1 = 1 To 20
If bereichArray(zaehler, zaehler1) > 0 Then
If kleinerWert(zaehler, 1) > bereichArray(zaehler, zaehler1) Then
kleinerWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
If groesserWert(zaehler, 1) < bereichArray(zaehler, zaehler1) Then
groesserWert(zaehler, 1) = bereichArray(zaehler, zaehler1)
End If
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) + bereichArray(zaehler, zaehler1)
zaehler2 = zaehler2 + 1
End If
Next zaehler1
mittelWert(zaehler, 1) = mittelWert(zaehler, 1) / zaehler2
LowWert(zaehler, 1) = mittelWert(zaehler, 1) - kleinerWert(zaehler, 1)
HighWert(zaehler, 1) = groesserWert(zaehler, 1) - mittelWert(zaehler, 1)
End If
zaehler2 = 0
Next zaehler
.Range("AD" & Azeile & ":AD" & Lzeile) = kleinerWert()
.Range("AE" & Azeile & ":AE" & Lzeile) = groesserWert()
.Range("AC" & Azeile & ":AC" & Lzeile) = mittelWert()
.Range("AF" & Azeile & ":AF" & Lzeile) = LowWert()
.Range("AG" & Azeile & ":AG" & Lzeile) = HighWert()
End With
End Sub
0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Ich habe mehrere Zeilen die ich miteinander vergleichen möchte.
Wenn in zwei Zeilen die Zellen B,C,D übereinstimmen und die Zellen A einen unterschiedlichen Wert haben,
dann sollen diese Zeilen bestehen bleiben.
Zeilen die in den Zellen B,C,D nicht übereinstimmen sollen gelöscht werden

Desweiteren sollen die Zeilen die passen noch so sortiert werden, dass sie als Paare geordnet sind / werden.


Beispie, so soll es dann aussehen:

GFM 1 100 453101 3 20.11.2008 08:13:03 SK 251.263 15.93 17.09 16.95 16.81 16.78 16.67 17.15 16.86 16.78 16.35
GFM 2 100 453101 3 20.11.2008 08:27:50 TM 251.258 16.81 17.15 17.17 16.81 16.77 17.13 17.27 16.84 16.84 16.66
GFM 1 111 453101 3 20.11.2008 08:42:06 TM 251.27 17.02 17.27 17.16 16.7 16.9 17.12 17.31 17.2 16.9 16.85
GFM 2 111 453101 3 20.11.2008 10:51:27 ES 251.311 16.38 16.6 16.34 16.25 16.34 16.64 16.58 15.81 16.78 16.28


Nach längerem testen hab ich festgestellt, dass das Makro filter1 noch nicht ganz passt.


Option Explicit
Option Base 1

Sub filter1()
Dim Lzeile As Long, zaehler1 As Long, zaehler2 As Long
Dim Auswahl As Variant
Set Auswahl = Worksheets("Data")

Lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Auswahl.Activate

ReDim ArrIndex(Lzeile) As Boolean
ReDim ArrQ(Lzeile, 3) As Variant
ReDim ArrZ(Lzeile, 3) As Variant
ArrQ() = Range("B2:D" & Lzeile + 1)
For zaehler1 = 1 To Lzeile
For zaehler2 = 1 To Lzeile
If ArrQ(zaehler1, 1) = ArrQ(zaehler2, 1) And ArrQ(zaehler1, 2) = ArrQ(zaehler2, 2) And ArrQ(zaehler1, 3) = ArrQ(zaehler2, 3) And zaehler1 <> zaehler2 Then
If ArrIndex(zaehler1) = False And ArrIndex(zaehler2) = False Then
If ArrZ(zaehler2, 1) <> ArrQ(zaehler1, 1) Then
ArrZ(zaehler1, 1) = ArrQ(zaehler2, 1)
ArrZ(zaehler1, 2) = ArrQ(zaehler2, 2)
ArrZ(zaehler1, 3) = ArrQ(zaehler2, 3)
ArrZ(zaehler2, 1) = ArrQ(zaehler1, 1)
ArrZ(zaehler2, 2) = ArrQ(zaehler1, 2)
ArrZ(zaehler2, 3) = ArrQ(zaehler1, 3)
ArrIndex(zaehler1) = True
ArrIndex(zaehler2) = True
End If
End If
End If
Next zaehler2
Next zaehler1
With Auswahl
.Range("B2:D" & Lzeile) = ArrZ()
.Columns("B").AutoFilter Field:=1, Criteria1:="="
.Rows("2:" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Delete Shift:=xlUp
.Cells.AutoFilter
.Columns("B:B").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

Worksheets("Report").Activate

End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi wiesel

musterdatei schicken bitte

gruss nighty

oberley@t-online.de
0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Hi nighty,

vielen Dank für deine Hilfe (Musterdatei).
Läuft auch fast perfekt.

Ich hab da noch eine kleines Problem.
Momentan muss ich ein paar mal auf den Start-Button des Makros drücken bis meine Daten komplett gefiltert werden (alles unnötige entfernt wurde).

Gibt es eine Möglichkeit, dies auch direkt durch nur einen einzigen Start des Makros zu erreichen ?
Seite:
...