Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1496to1500
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

Zählen, kopieren, doppelte Löschen

Zählen, kopieren, doppelte Löschen
31.05.2016 10:51:24
Gregor
Hallo zusammen
Kann folgender Code (Teil eines Makros) vereinfacht werden, damit er schneller läuft. Zudem möchte ich jeder gleiche Eintrag zählen und die jeweilige Summe pro Eintrag in Spalte L eintragen.
'--Spalten H und G kopieren, doppelte löschen und sortieren
With Worksheets("Test")
'kopieren
.Activate
.Columns("G:H").Copy
.Range("J1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'doppelte löschen
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
For Start = 1 To intLastRow
For Beginn = (1 + Start) To intLastRow
If (.Cells(Start, "J") = .Cells(Beginn, "J") And .Cells(Start, "K") = .Cells(Beginn, "K")) Then
.Range(Cells(Start, "J"), Cells(Start, "K")).ClearContents
End If
Next
Next
'sortieren
.Sort.SortFields.Add Key:=Range("J2:J900"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Test").Sort
.SetRange Range("J2:K900")
.Orientation = xlTopToBottom
.Apply
End With
End With
Vielen Dank und Gruss
Gregor

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Musterdatei mit Daten..
31.05.2016 11:06:45
UweD
wäre nicht schlecht

AW: Musterdatei mit Daten..
31.05.2016 11:28:21
Gregor
Hallo
Ja gerne
https://www.herber.de/bbs/user/105886.xlsm
... und wie gesagt, wenn möglich Code vereinfachen und je gleicher Eintrag Summe in Spalte L
Danke und Gruss
Gregor

AW: Musterdatei mit Daten..
31.05.2016 11:43:22
UweD
Hallo nochmal
Da war ich ja gar nicht weit ertfernt....
Andere Sortierung und Zählen statt Summieren

Sub dfdfd()
Dim intLastRow%
With Worksheets("Test")
'reset
Columns("J:M").Clear
'kopieren
.Columns("G:H").Copy .Range("J1")
'doppelte löschen
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
.Range("J2:K" & intLastRow).RemoveDuplicates Columns:=Array(1, 2)
'sortieren
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
With ActiveWorkbook.Worksheets("Test").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("J2:J" & intLastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("K2:K" & intLastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("J1:K" & intLastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Zählen
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
.Range("L2:L" & intLastRow).FormulaR1C1 = "=COUNTIFS(C[-5],RC[-2],C[-4],RC[-1])"
End With
End Sub

Gruß UweD

Anzeige
AW: Musterdatei mit Daten..
31.05.2016 11:29:23
UweD
geraten...

Sub dfdfd()
Dim intLastRow%
With Worksheets("Test")
'reset
Columns("J:M").Clear
'kopieren
.Columns("G:H").Copy .Range("J1")
'doppelte löschen
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
.Range("J2:K" & intLastRow).RemoveDuplicates Columns:=Array(1, 2)
'sortieren
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
.Sort.SortFields.Add Key:=Range("J2:J" & intLastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Test").Sort
.SetRange Range("J2:K" & intLastRow)
.Orientation = xlTopToBottom
.Apply
End With
'summieren >>>>> Annahme Summen aus Spalte I
intLastRow = .Cells(Rows.Count, "J").End(xlUp).Row
.Range("L2:L" & intLastRow).FormulaR1C1 = "=SUMIFS(C[-3],C[-5],RC[-2],C[-4],RC[-1])"
End With
End Sub

Gruß UweD

Anzeige
AW: Musterdatei mit Daten..
31.05.2016 12:28:50
Gregor
Hallo Uwe
Klappt so super, vielen Dank.
Gruss Gregor

Danke für die Rückmeldung owT
03.06.2016 15:36:00
UweD

um doppelte zu löschen, ...
31.05.2016 11:09:51
Rudi
Hallo,
.. solltest du die RemoveDuplicates-Methode verwenden.
Gruß
Rudi

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige