Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Zeilen und Zellen mit Bedingung zusammenfassen

Thema geschlossen 
Baumstrukturmodus
Zeilen und Zellen mit Bedingung zusammenfassen
lizzard Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.01.2017
Version(en): 2010
#11
24.01.2017, 14:05
(24.01.2017, 13:54)atilla schrieb: noch eine Frage und Beschreibungstext unterscheidet sich wenn die Spalten D, F, H, M gleich sind?

Anders, Spalte E kann einen anderen Text haben, obwohl D,F,H,M gleich sind??

Nein, der Beschreibungstext ist gleich, bzw. den kann ich in der Ergebnistabelle neu aufbauen.
Wer oft die Wahrheit sagt, braucht ein schnelles Pferd.
Suchen
Antworten Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#12
24.01.2017, 14:50 (Dieser Beitrag wurde zuletzt bearbeitet: 24.01.2017, 14:50 von atilla.)
Hallo,

schau mal ob das hinhaut:

Edit im Code Variabele i und j nachträglich deklariert
Code:
Sub zusammenfassen()
Dim i as Long, j as Long
Dim lngZq As Long, lngZz As Long
Dim arr1(), arr2()
Dim feld
Dim cKey
Dim cO As Object

 Set cO = CreateObject("Scripting.Dictionary")
 With Sheets("Tabelle1")
   lngZq = .Cells(.Rows.Count, 1).End(xlUp).Row
   feld = .Range("A1:N" & lngZq)
 End With

 For i = 2 To lngZq
   cKey = feld(i, 13) & "#" & feld(i, 4) & "#" & feld(i, 6) & "#" & feld(i, 8) & "#" & feld(i, 14)
   cO(cKey) = cO(cKey) & "|" & feld(i, 1)
 Next i
 
 ReDim arr1(cO.Count, 1)
 ReDim arr2(cO.Count, 2)
 For Each cKey In cO
   arr1(j, 0) = Split(cKey, "#")(0)
   arr1(j, 1) = Split(cKey, "#")(1)
   arr2(j, 0) = Split(cKey, "#")(2)
   arr2(j, 1) = cO(cKey)
   arr2(j, 2) = CDbl(Split(cKey, "#")(4))
   j = j + 1
 Next
 
 With Sheets("Tabelle2")
   lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   .Range("A2:F" & lngZz).ClearContents
   .Cells(2, 1).Resize(j, 2).Value = (arr1)
   .Cells(2, 4).Resize(j, 3).Value = (arr2)
 End With
 
End Sub


Damit Du nicht sagst, es passiert nichts, hier das Ergebnis welches ich erhalte:

Arbeitsblatt mit dem Namen 'Tabelle3'
 ABCDEF
1ArtikelNrnameDescriptionMarkeNrGewicht
2444444Typ1 Alfa Romeo|100113|100114|100115|100117|100121|100122|100118|100120|100125|100119|100123|100112|100124|10011618
3111111Typ1 Alfa Romeo|100015|100014|100016|100001|100006|100004|100019|100010|100012|100017|100002|100008|100011|100005|100009|100020|100013|100018|100003|10000721
4111111Typ1 Alfa Romeo|100038|100058|100021|100039|100040|100023|100045|100043|100026|100050|100048|100032|100030|100054|100033|100034|100035|100055|100041|100046|100028|100052|100036|10005621
5111111Typ2 Alfa Romeo|100022|100044|100025|100049|100029|100053|100031|100037|100057|100042|100024|100047|100027|10005121
6666666Typ2 Alfa Romeo|100150|100152|100144|100147|100143|100146|100140|100153|100154|100155|100141|100148|100145|100149|100142|10015117,6
7666666Typ2 Alfa Romeo|100166|100168|100160|100162|100159|100163|100156|100169|100170|100171|100157|100164|100161|100165|100158|10016717,6
8999999Typ2 Alfa Romeo|100234|100228|100233|100238|100239|100244|10024517
9999999Typ1 Alfa Romeo|100231|100232|100242|100229|100237|100240|100227|100230|100235|100236|100241|10024317
10555555Typ1 Alfa Romeo|100127|10012819,4
11555555Typ2 Alfa Romeo|100129|100131|100135|100136|100132|100134|100139|100133|100137|100126|100138|10013019,4
12222222Typ2 Alfa Romeo|100076|10007523
13222222Typ1 Alfa Romeo|100077|100059|100064|100062|100080|100068|100071|100072|100073|100078|100060|100066|100070|100063|100067|100081|100069|100074|100079|100061|10006523
14222222Typ1 Alfa Romeo|100105|100082|100083|100088|100086|100093|100091|100099|100097|100100|10010123
15222222Typ2 Alfa Romeo|100102|100084|100089|100095|100103|100087|100092|100096|100098|100104|100085|100090|10009423
16777777Typ2 Alfa Romeo|100182|100184|100176|100179|100175|100178|100172|100185|100186|100187|100173|100180|100177|100181|100174|10018318,6
17777777Typ2 Alfa Romeo|100198|100200|100192|100194|100191|100195|100188|100201|100202|100203|100189|100196|100193|100197|100190|10019918,6
18121212Typ2 Alfa Romeo|100253|100247|100252|100257|100258|100263|100264|100250|100251|10026118,2
19121212Typ1 Alfa Romeo|100248|100256|100259|100246|100249|100254|100255|100260|10026218,2
20333333Typ1 Alfa Romeo|100107|100110|100111|100106|100108|10010922
21888888Typ1 Alfa Romeo|100209|100225|100206|10020520,76
22888888Typ2 Alfa Romeo|100216|100221|100226|100210|100222|100204|100212|100215|100218|100219|100220|100224|100207|100208|100211|100214|100223|100213|10021720,76
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg


Ich habe das Gewicht mit zur Feststellung der Doppelten genommen.
Wenn das nicht sein soll, muss ich nachsitzen. Wenn Du sicher bist, dass Beschreibung gleich ist, dann kann ich das ohne nachsitzen leicht einbauen.
Gruß Atilla
Suchen
Antworten Top
lizzard Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.01.2017
Version(en): 2010
#13
24.01.2017, 15:15
@attila: Perfekt - funktioniert einwandfrei!

Wenn ich das Script nun um weitere Felder in der Ausgabe erweitern möchte, was müsste ich da anpassen?
Wer oft die Wahrheit sagt, braucht ein schnelles Pferd.
Suchen
Antworten Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#14
24.01.2017, 15:39
Hallo,

das geht nicht so einfach.
Man muss an mehreren Stellen Änderung vornehmen.

Ich habe den Code jetzt verändert, so dass Du selber beliebige Spalten anpassen kannst.
Schau Dir die Kommentare im Code an, dann wirst Du das System leicht erfassen.

Wichtig!
Ich nutze in Tabelle1 die Spalte O als Hilfsspalte. Dort wird temporär eine Formel rein geschrieben und am Ende wieder entfernt!



Code:
Sub zusammenfassen2()
Dim i As Long, j As Long, x As Long
Dim lngZq As Long, lngZz As Long
Dim arr1(), arr2()
Dim feld, feld2
Dim cKey
Dim cO As Object

 Set cO = CreateObject("Scripting.Dictionary")
 With Sheets("Tabelle1")
   lngZq = .Cells(.Rows.Count, 1).End(xlUp).Row
   .Range("O2:O" & lngZq).FormulaLocal = "=M2&" & """#""" & "&D2&" & """#""" & "&F2&" & """#""" & "&H2"
   feld = .Range("A1:N" & lngZq)
   feld2 = .Range("O1:O" & lngZq)
   .Range("O2:O" & lngZq).ClearContents
 End With

 For i = 2 To lngZq
   cKey = feld(i, 13) & "#" & feld(i, 4) & "#" & feld(i, 6) & "#" & feld(i, 8)
   cO(cKey) = cO(cKey) & "|" & feld(i, 1)
 Next i
 
 ReDim arr(cO.Count, 5)    ' die Zahl gibt die Anzahl der einzulesenden Saplten minus 1 Spalte an

 For Each cKey In cO
   x = Application.Match(cKey, feld2, 0)
   arr(j, 0) = feld(x, 1)     'Artikel-Nr
   arr(j, 1) = feld(x, 4)     'Name
   arr(j, 2) = feld(x, 5)     'Description
   arr(j, 3) = feld(x, 6)     'Marke
   arr(j, 4) = Replace(cO(cKey), "|", "", 1, 1)  'Nummern zusammenfassung
   arr(j, 5) = feld(x, 14)     'Gewicht
   j = j + 1
 Next
 
 With Sheets("Tabelle2")
   lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   .Range("A2:F" & lngZz).ClearContents
   .Cells(2, 1).Resize(j, 6).Value = (arr)
 End With
 
End Sub
Gruß Atilla
Suchen
Antworten Top
lizzard Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.01.2017
Version(en): 2010
#15
24.01.2017, 16:19 (Dieser Beitrag wurde zuletzt bearbeitet: 24.01.2017, 16:19 von lizzard.)
(24.01.2017, 15:39)atilla schrieb: Hallo,

das geht nicht so einfach.
Man muss an mehreren Stellen Änderung vornehmen.

Ich habe den Code jetzt verändert, so dass Du selber beliebige Spalten anpassen kannst.
Schau Dir die Kommentare im Code an, dann wirst Du das System leicht erfassen.

Wichtig!
Ich nutze in Tabelle1 die Spalte O als Hilfsspalte. Dort wird temporär eine Formel rein geschrieben und am Ende wieder entfernt!



Code:
Sub zusammenfassen2()
Dim i As Long, j As Long, x As Long
Dim lngZq As Long, lngZz As Long
Dim arr1(), arr2()
Dim feld, feld2
Dim cKey
Dim cO As Object

 Set cO = CreateObject("Scripting.Dictionary")
 With Sheets("Tabelle1")
   lngZq = .Cells(.Rows.Count, 1).End(xlUp).Row
   .Range("O2:O" & lngZq).FormulaLocal = "=M2&" & """#""" & "&D2&" & """#""" & "&F2&" & """#""" & "&H2"
   feld = .Range("A1:N" & lngZq)
   feld2 = .Range("O1:O" & lngZq)
   .Range("O2:O" & lngZq).ClearContents
 End With

 For i = 2 To lngZq
   cKey = feld(i, 13) & "#" & feld(i, 4) & "#" & feld(i, 6) & "#" & feld(i, 8)
   cO(cKey) = cO(cKey) & "|" & feld(i, 1)
 Next i
 
 ReDim arr(cO.Count, 5)    ' die Zahl gibt die Anzahl der einzulesenden Saplten minus 1 Spalte an

 For Each cKey In cO
   x = Application.Match(cKey, feld2, 0)
   arr(j, 0) = feld(x, 1)     'Artikel-Nr
   arr(j, 1) = feld(x, 4)     'Name
   arr(j, 2) = feld(x, 5)     'Description
   arr(j, 3) = feld(x, 6)     'Marke
   arr(j, 4) = Replace(cO(cKey), "|", "", 1, 1)  'Nummern zusammenfassung
   arr(j, 5) = feld(x, 14)     'Gewicht
   j = j + 1
 Next
 
 With Sheets("Tabelle2")
   lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   .Range("A2:F" & lngZz).ClearContents
   .Cells(2, 1).Resize(j, 6).Value = (arr)
 End With
 
End Sub

Hi attila,

vielen Dank jetzt wirds klar Idea Das Erweitern ist nun kein Problem.
Kann es sein dass die Zeile
Code:
.Range("A2:F" & lngZz).ClearContents
nicht notwendig ist?
Noch eine Frage zum Erweitern des Codes: ist es möglich die Spaltenüberschriften aus Tabelle1 mit zu kopieren?
Wer oft die Wahrheit sagt, braucht ein schnelles Pferd.
Suchen
Antworten Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#16
24.01.2017, 16:41
Hallo,

mit der gezeigten Zeile wurden bestehende Daten in der Zieltabelle gelöscht, also sollte drin bleiben.
Dann könntest Du die Überschriften also einmal manuell rüberkopieren, diese würden dann auch belassen.

Möchtest Du aber die Überschriften immer per Code übertragen, dann würde ich den letzten Teil im Code so schreiben:

Code:
 With Sheets("Tabelle2")
   lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   .Cells.ClearContents
   .Cells(2, 1).Resize(j, 6).Value = (arr)
   .Cells(1, 1).Value = Sheets("Tabelle1").Cells(1, 1).Value 'Zelle A1 in Tabelle2 = Zelle A1 der Tabelle1
   .Cells(1, 2).Value = Sheets("Tabelle1").Cells(1, 2).Value 'Zelle B1 in Tabelle2 = Zelle B1 der Tabelle1
   '...usw
   'wenn zusammenhängendgeht auch
   '.Range("A1:F1").Value = Sheets("Tabelle1")Range("A1:F1").Value
 End With
Gruß Atilla
Suchen
Antworten Top
BoskoBiati Offline
नौसिखिया [vidyaarthi]

Registriert seit: 13.04.2014
Version(en): 365, 2019
#17
24.01.2017, 16:56
Hallo,

hier mal ein Entwurf mit einer Hilfsspalte, habe momentan keine Zeit, das weiter zu bearbeiten.



.xlsx   typentest-2.xlsx (Größe: 585,35 KB / Downloads: 2)
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
[-] Folgende(r) 1 Nutzer sagt Danke an BoskoBiati für diesen Beitrag:
  • lizzard
Suchen
Antworten Top
lizzard Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.01.2017
Version(en): 2010
#18
24.01.2017, 16:59
(24.01.2017, 16:41)atilla schrieb: Hallo,

mit der gezeigten Zeile wurden bestehende Daten in der Zieltabelle gelöscht, also sollte drin bleiben.
Dann könntest Du die Überschriften also einmal manuell rüberkopieren, diese würden dann auch belassen.

Möchtest Du aber die Überschriften immer per Code übertragen, dann würde ich den letzten Teil im Code so schreiben:

Code:
 With Sheets("Tabelle2")
   lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   .Cells.ClearContents
   .Cells(2, 1).Resize(j, 6).Value = (arr)
   .Cells(1, 1).Value = Sheets("Tabelle1").Cells(1, 1).Value 'Zelle A1 in Tabelle2 = Zelle A1 der Tabelle1
   .Cells(1, 2).Value = Sheets("Tabelle1").Cells(1, 2).Value 'Zelle B1 in Tabelle2 = Zelle B1 der Tabelle1
   '...usw
   'wenn zusammenhängendgeht auch
   '.Range("A1:F1").Value = Sheets("Tabelle1")Range("A1:F1").Value
 End With

Alles klar, Danke dir, werde ich ausprobieren!
Wer oft die Wahrheit sagt, braucht ein schnelles Pferd.
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste