Registriert seit: 29.09.2015
Version(en): 2030,5
15.06.2019, 13:06
(Dieser Beitrag wurde zuletzt bearbeitet: 15.06.2019, 13:09 von snb.)
In VBA: Code: Sub M_snb() sn = Range("D1:G24") sp = Array(116, 128, 140, 152, 164, 176, "S", "XS") With CreateObject("scripting.dictionary") .Item(" ") = sp For j = 2 To UBound(sn) For jj = 1 To UBound(sn, 2) If sn(j, jj) <> "" Then ReDim st(7) If .exists(sn(1, jj)) Then st = .Item(sn(1, jj)) y = Application.Match(sn(j, jj), sp, 0) - 1 st(y) = st(y) + 1 .Item(sn(1, jj)) = st End If Next Next Sheet1.Cells(40, 1).Resize(.Count) = Application.Transpose(.keys) Sheet1.Cells(40, 2).Resize(.Count, 8) = Application.Index(.items, 0, 0) End With End Sub
Registriert seit: 29.09.2015
Version(en): 2030,5
15.06.2019, 15:27
(Dieser Beitrag wurde zuletzt bearbeitet: 15.06.2019, 15:31 von snb.)
Oder: Code: Sub M_snb() sn = Sheet1.Range("D1:G24") sp = Array("Artikel", 116, 128, 140, 152, 164, 176, "S", "XS", "Summe") With CreateObject("scripting.dictionary") .Item(" ") = sp For j = 2 To UBound(sn) For jj = 1 To UBound(sn, 2) If sn(j, jj) <> "" Then ReDim st(9) st(0) = sn(1, jj) If .exists(sn(1, jj)) Then st = .Item(sn(1, jj)) y = Application.Match(sn(j, jj), sp, 0) - 1 st(y) = st(y) + 1 .Item(sn(1, jj)) = st End If Next Next For Each it In .keys If it <> " " Then st = .Item(it) st(UBound(st)) = Application.Sum(st) .Item(it) = st End If Next Sheet1.Cells(40, 1).Resize(.Count, 10) = Application.Index(.items, 0, 0) Sheet1.ListObjects.Add 1, Sheet1.Cells(40, 1).CurrentRegion, , 1 End With End Sub
Registriert seit: 10.04.2014
Version(en): Office 2019
(15.06.2019, 11:03)DerUser3 schrieb: @Jockel, ja genau so hatte ich mir das vorgestellt. Wenn du hierfür eine Schritt für Schrittanleitung geben würdest, wäre ich dir sehr Dankbar. Hi, hab hier leider größere Schwierigkeiten. Wenn ich heute abend dazu komme, geht das klar. Kein Problem... Oder nimmst du lieber die VBA-Variante..?
Gruß Jörg stolzes Mitglied im ----Excel-Verein
Im Wort FEHLER steckt auch das Wort HELFER!
FEHLER helfen dir. Nimm deine FEHLER an und lerne aus ihnen. Wenn du es zulässt, dann werden sie dich stärken
Im Wort
Registriert seit: 10.04.2014
Version(en): Office 2019
Es hat etwas gedauert, aber hier (m)ein Ergebnis. Es gibt freilich mehrere Wege, die zum Ziel führen (kürzere oder längere, verschlungere und geradlinigere) Wenn's passt gut, wenn nicht einfach nochmal melden (man könnte sicher noch das Eine oder Andere einflechten - wie z.B. eine sortierte Überschriftenzeile).
13062019_Bestellung_Leistungsturnen.xlsx (Größe: 113,15 KB / Downloads: 6)
Gruß Jörg stolzes Mitglied im ----Excel-Verein
Im Wort FEHLER steckt auch das Wort HELFER!
FEHLER helfen dir. Nimm deine FEHLER an und lerne aus ihnen. Wenn du es zulässt, dann werden sie dich stärken
Im Wort
|