Makro beschleunigen (Zählenwenns)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Wobei sich natürlich die Frage stellt, welcher von den Datumswerten jetzt genommen werden soll.
manuell kann man die Tabelle auch recht einfach mit Hilfe einer Pivottabelle erstellen:
Im Assisten der PivotTabelle folgende Einstellungen:
- ZEILEN: Spalte H "Verkäufer"
- SPALTEN: Spalte I "Kauf"
- WERTE: irgendeine Spalte nach Anzahl, Spalte A ENDE(Datum) nach Maximum (oder Minmum)
in der fertigen Pivottabelle:
- DropDown-Filter "Spaltenbeschriftungen" der Pivottabelle alles ausblenden ausser "a"
- Pivottabelle kopieren und an gleicher oder anderer Stelle als Wert einfügen (Pivotbeziehung aufheben)
- in der Ergebnisspalte "a" per Autofilter die Zeilen Fertig.
ansonsten kann man das auch manuell so erledigen:
1. Tabelle nach Spalte H (Verkäufer) und Spalte I (kauf) sortieren
2. in einer ersten Hilfsspalte (J) folgende Formel
=Wenn(I2="a";Wenn(H2=H1;J1+1;1);"")
3. in einer zweiten Hilfspalte (K) folgende Formel:
=Wenn(Und(I2="a";Oder(H2H3;I2I3);J2>=3);1;"")
4. dann alle Zeilen kopieren, bei denen in K eine 1 steht (Autofilter oder SpecialCells)
das sieht als Code dann so aus:

Sub Suchen_und_Kopiern()
With Sheets("Woche")
With .Cells(1, 1).CurrentRegion
.Sort key1:=.Cells(1, 8), order1:=xlAscending, _
key2:=.Cells(1, 9), order2:=xlAscending, Header:=xlYes
With .Columns(.Columns.Count).Resize(.Rows.Count - 1, 2).Offset(1, 1)
With .Columns(1)
.FormulaR1C1 = "=IF(RC9=""a"",IF(RC8=R[-1]C8,R[-1]C+1,1),"""")"
End With
With .Columns(2)
.FormulaR1C1 = _
"=IF(AND(RC9=""a"",OR(RC8R[1]C8,RC[-2]R[1]C[-2]),RC[-1]>=3),1,"""")"
If WorksheetFunction.Sum(.Cells) > 0 Then
Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireRow, _
.Worksheet.Columns(8)).Copy Sheets("Verkäufer").Cells(2, 1)
Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireRow, _
.Worksheet.Columns(1)).Copy Sheets("Verkäufer").Cells(2, 2)
End If
End With
.ClearContents
End With
End With
End With
End Sub

bei sehr grossen Datenmengen könnte man nochmal die Hilfsspalten kopieren und als Wert einfügen und dann die Tabelle nach der zweiten Hilfsspalte sortieren, so dass die zu kopierenden Daten einen lückenlosen Zellblock bilden.
Gruß Daniel

Hi zusammen,
ich freue mich natürlich, daß die Geschichte funktioniert und Dir gefällt.
Allerdings ist mir noch ein kleiner Fehler aufgefallen: in der Zeile...

Set c = nachWs.Range("D1:D" & maxZ).Find(2, nachWs.Range("D1"), _
xlValues, xlWhole)

sucht das Makro nach der Zahl 2, aber das funktioniert leider nur zufällig, wenn die zweite Zeile ungleich der ersten ist.
Deshalb weiter oben die Änderung:

maxZ = nachWs.Range("A" & vonWs.Rows.Count).End(xlUp).Row
If maxZ > 1 Then
nachWs.Range("A2:C" & maxZ).Clear       ' nur bis C statt D
nachWs.Range("D2:D" & maxZ).Value = 2   ' neu ***
End If

Damit wird die komplette Spalte D mit 2ern vorbelegt, d.h. damit ist sichergestellt, daß die 2 definitiv vorhanden ist und damit mit .find gefunden wird.
Um "beide Codes zu verstehen" fängst Du am besten damit an, sie mit F8 schrittweise laufen zu lassen bzw. geeignete Haltepunkte zu setzen (z.B. vor oder nach Schleifen, bei denen man sich nicht ALLE Durchgänge ansehen will) oder einfach eine Zeile mit

Stop

einzufügen.
Ganz nett ist es auch, "ganz oben" eine Konstante zu setzen, z.B.

Const testen = True

und dann im Code an besagten Stellen zu schreiben

If testen Then Stop

dann muß man nur testen = False definieren, um die Stops "auszublenden".
Happy Exceling,
Michael

Beliebteste Forumthreads (12 Monate)

Makro beschleunigen (Zählenwenns)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread