400 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)
So als erstes,

nachträglich Frohe Weihnachten und Ein Gutes Neues Jahr.


Also ich hab nach 2 Wochen mal wieder ZEit etwas zu testen. Läuft eigendlich auch gut allerdings gibts ein kleines Problem an dem ich verzweifle.

Wenn ich meine Daten auf dem 1 Sheet in excel habe und das makro mit dem button dort ausführe, dann funktioniert alles.

Jetzt habe ich aber den button zum start des makros auf dem sheet1 und die daten die sortiert, gelöscht... werden sollen befinden sich auf dem sheet3 (Name: Data). Irgendwie bekomm ich es nicht hin, dass das makro auch dort funktioniert.

Kann jemand helfen ?
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Wiesel

in der dritten zeile deine wahl tabelle eintragen

eventuell noch einen ruecksprung einfuegen am ende des makros

Worksheets("Tabelle1").Activate


gruss nighty

Option Explicit
Option Base 1
Sub filter1()
Dim Lzeile As Long, Zaehler1 As Long, Zaehler2 As Long
Dim Auswahl As Variant
Set Auswahl = Worksheets("Tabelle2")
Lzeile = Auswahl.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
End Sub
0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Super klappt 1a. Vielen Dank.

Jetzt sitz ich schon am nächsten.

ich habe ein makro geschrieben das folgendes tut:

die spalte i einer tabelle von unten nach oben "abtasten" und sobald ein wert ungleich null dasteht, den mittelwert der untesten (letzten) 100 zellen berechnen. und die mittelwert der jeweiligen zeile in die zelle ac schreibt.

habs mal so versucht:

Option Explicit

Sub average()
Dim i As Integer
For i = 0 To 65530
Range("I65530").End(xlUp).Offset(-i, 0).Rows.Select
If Selection <> 0 Then
Range("AC100").Formula = Selection / 100
Exit Sub
End If
Next
End Sub

irgenwie steckt noch der fehlerteufel drin
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi wiesel

noch mit ereignissausschaltung

gruss nighty

Option Explicit
Option Base 1
Sub filter1()
Call EventsOff
Dim Lzeile As Long, Zaehler1 As Long, Zaehler2 As Long
Dim Auswahl As Variant
Set Auswahl = Worksheets("Tabelle2")
Lzeile = Auswahl.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("Tabelle1").Activate
EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all

das sollte so heissen

Call EventsOn

statt

EventsOn

am ende des makros

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

du kannst eine einzelne zelle auf <>0 abfragen,aber kein bereich

hier waere eine doppelte schleife die loesung

range anweisungen wie selectierungen sollten auch verbannt werden(zu rechenintensiv)

probier dich mal mit einem array,das ist aehnlich in der handhabung mit den schleifen

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

hier ein ansatz

gruss nighty

Sub ArrayBeispiel()
Dim intArray() As Variant
With ActiveSheet
intArray() = Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
For zaehler = 1 To UBound(intArray())
If intArray(zaehler, 1) <> 0 Then
'Dein Code
End If
Next zaehler
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi wiesel

oder schick mir eine mustertabelle

gruss nighty

oberley@t-online.de

mit aussagefaehigen betreff bitte
0 Punkte
Beantwortet von daswasserwiesel Einsteiger_in (43 Punkte)
Sieht jetyt so aus will aber nix ausgeben.
wenn in Spalte I was steht, dann den mittelwert berechnen und in der jeweiligen zeile in zelle ac ausgeben.


Sub average()
Dim intArray() As Variant
Dim Zaehler As Long
Dim Auswahl As Variant
Set Auswahl = Worksheets("Data")
Auswahl.Activate
intArray() = Range("I1:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Zaehler = 1 To UBound(intArray())
If intArray(Zaehler, 1) <> 0 Then
Dim i As Integer
For i = 0 To 65530
Range("I65530").End(xlUp).Offset(-i, 0).Rows.Select
If Selection <> 0 Then
Range("I1:I").Formula = Selection / 100

End If
Next
End If
Next Zaehler
End With

Worksheets("Report").Activate

End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all :-)

die gewuenschte makroloesung

gruss nighty

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
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
End Sub
...