Alle Zeilen-Nr.s bei partieller Übereinstimmung in

Hallo zusammen,
verfolge euer Forum schon eine ganze Weile und habe durch eure guten Lösungen schon viele Probleme erfolgreich "selber" lösen können (Danke schon mal dafür :D)
Ich habe leider nur noch sehr eingerostete bis nicht mehr vorhandene Programmierkenntnisse und stehe vor einem Problem, bei dem ich einfach nicht auf die Lösung komme.
Habe leider online noch keine Lösung finden können, weshalb ich eure direkte Hilfe erbete :).
Folgendes Problem stellt sich mir:
Ich habe eine Tabelle mit sehr vielen Kombinationsmöglichkeiten, bei denen bestimmte Zellwerte in einigen Zellen übereinstimmen.
Jetzt möchte ich die Zeilen, welche partiell übereinstimmen, als eine Zeile in ein neues Tabellenblatt kopieren, wobei einige Zellen addiert und einige ergänzt werden sollen (um den vorherigen Bezug wieder herstellen zu können).
Ich hab da mal was vorbereitet, da man sich von meiner wirren Erklärungen selbst wahrscheinlich kein Bild machen kann ;)
Die Kriterien 1-3 (hier verkettet in einem Feld) sollen Zeilenweise vergleichen werden.
Bei Übereinstimmung der 3 Kriterien (des Kriteriums) soll eine Zeile mit den 3 Kriterien (dem Kriterium) in der Zieltabelle (möglichst in einem anderen Tabellenblatt) erstellt werden, bei dem die jeweilien Menge addiert und die Lfd-Nr. ALLER betroffener Zeilen in eine Zelle geschrieben werden (am Besten mit einem Trenner)
Ausgangstabelle
Lfd-Nr. Kriterium Menge
1 rot;m;slim 1
2 rot;l;normal 5
3 rot;s;slim 8
4 rot;m;normal 9
5 rot;m;slim 6
6 rot;l;normal 1
7 blau;m;slim 4
8 blau;l;slim 8
9 blau;s;normal 5
10 blau;m;normal 3
11 blau;l;slim 4
12 blau;s;slim 2
13 blau;m;normal 7
14 blau;m;normal 4
15 blau;s;slim 1
Zieltabelle
Lfd-Nr. Kriterium kummulierte Menge
1; 5 rot;m;slim 7
2; 6 rot;l;normal 6
3 rot;s;slim 8
4 rot;m;normal 9
7 blau;m;slim 4
8; 11 blau;l;slim 12
9 blau;s;normal 5
10; 13; 14 blau;m;normal 14
12; 15 blau;s;slim 3
Ich stehe da irgendwie auf dem Schlauch, besonders bei der Frage wie ich alle ursprünglichen LFD-Nr.s in ein Feld bekomme?
Vielen lieben Dank im Voraus für eure Hilfe und einen schönen Abend noch.
Gruß
Winnie

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub sdsdjs() On Error GoTo Fehler Dim TB1, TB2, i As Double, j As Double Dim LR1 As Double, LR2 As Double Application.ScreenUpdating = False Set TB1 = Sheets("Tabelle1") Set TB2 = Sheets("Tabelle2") LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A With TB2 .Cells.ClearContents TB1.Columns(2).Copy .Columns(2) .Columns(2).RemoveDuplicates Columns:=1, Header:=xlYes .Columns(1).NumberFormat = "@" .Cells(1, 1) = "Lfd-Nr." .Cells(1, 3) = "kummulierte Menge" LR2 = .Cells(Rows.Count, 2).End(xlUp).Row .Range(.Cells(2, 3), .Cells(LR2, 3)).FormulaR1C1 = _ "=SUMIF(" & TB1.Name & "!C[-1],RC[-1]," & TB1.Name & "!C)" 'Formel .Range(.Cells(2, 3), .Cells(LR2, 3)) = _ .Range(.Cells(2, 3), .Cells(LR2, 3)).Value ' Werte For i = 2 To LR2 For j = 2 To LR1 If TB1.Cells(j, 2) = .Cells(i, 2) Then .Cells(i, 1) = .Cells(i, 1) & TB1.Cells(j, 1) & "; " End If Next j .Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 2) ' letzte ; weg Next i End With Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Hallo Uwe,
ich hab die Formel jetzt für meine große Tabelle umgesetzt/erweitert und laufe in ein Problem, was ich nicht ganz nachvollziehen kann...
Die tatsächliche Tabelle hat 32 Spalten und zum Testzweck 115 Zeilen + Überschriften.
Dabei gibt es 3 Spalten (E, V & W) die aufsummiert und 3 Spalten (A, B & C) welche erweitert werden müssen.
Es will mit der großen Tabelle leider nicht so recht funktionieren, und es tretren nachfolgende Probleme auf:
1.) Die Spaltenüberschrift der "Summenspalten" (es gibt 3 Spalten wo ich die Summe bilden muss) wird bei Durchführung des nachfolgenden Befehls mit einer 0 überschrieben (ohne Ausführung der Zeile stehen die richtigen Spaltennamen aus Tabelle 1 drin). In der zweiten Tabellen-Zeile werden die richtigen Summen eingetragen.

       .Range(.Cells(2, 5), .Cells(LR2, 5)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[+1],RC[+1]," & TB1.Name & "!C)" 'Formel 1
.Range(.Cells(2, 5), .Cells(LR2, 5)) = .Range(.Cells(2, 5), .Cells(LR2, 5)).Value        _
' Werte 1
.Range(.Cells(2, 22), .Cells(LR2, 22)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[-16],RC[-16]," & TB1.Name & "!C)" 'Formel 2
.Range(.Cells(2, 22), .Cells(LR2, 22)) = .Range(.Cells(2, 22), .Cells(LR2, 22)).Value    _
' Werte 2
.Range(.Cells(2, 23), .Cells(LR2, 23)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[-17],RC[-17]," & TB1.Name & "!C)" 'Formel 3
.Range(.Cells(2, 23), .Cells(LR2, 23)) = .Range(.Cells(2, 23), .Cells(LR2, 23)).Value                         ' Werte 3

2.) Die eindeutigen Werte werden in die Tabelle 2 reingeschrieben, es werden ausser den Summen der ersten Zeile aber keine weiteren Werte eingetragen.
Desweiteren ist nach der ersten Zeile Schluss, wobei ich vermute dass diese beiden Dinge zusammenhängen.
Hier der erweiterte Code

Sub Test4()
On Error GoTo Fehler
Dim TB1, TB2, i As Double, j As Double
Dim LR1 As Double, LR2 As Double
Application.ScreenUpdating = False
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row                                'letzte Zeile  _
der Spalte A
With TB2
.Cells.ClearContents
TB1.Columns(6).Copy .Columns(6)
.Columns(6).RemoveDuplicates Columns:=1, Header:=xlYes
.Columns(1).NumberFormat = "@"
.Columns(2).NumberFormat = "@"
.Columns(3).NumberFormat = "@"
.Cells(1, 1) = TB1.Cells(1, 1)
.Cells(1, 2) = TB1.Cells(1, 2)
.Cells(1, 3) = TB1.Cells(1, 3)
.Cells(1, 4) = TB1.Cells(1, 4)
.Cells(1, 5) = TB1.Cells(1, 5)
.Cells(1, 7) = TB1.Cells(1, 7)
.Cells(1, 8) = TB1.Cells(1, 8)
.Cells(1, 9) = TB1.Cells(1, 9)
.Cells(1, 10) = TB1.Cells(1, 10)
.Cells(1, 11) = TB1.Cells(1, 11)
.Cells(1, 12) = TB1.Cells(1, 12)
.Cells(1, 13) = TB1.Cells(1, 13)
.Cells(1, 14) = TB1.Cells(1, 14)
.Cells(1, 15) = TB1.Cells(1, 15)
.Cells(1, 16) = TB1.Cells(1, 16)
.Cells(1, 17) = TB1.Cells(1, 17)
.Cells(1, 18) = TB1.Cells(1, 18)
.Cells(1, 19) = TB1.Cells(1, 19)
.Cells(1, 20) = TB1.Cells(1, 20)
.Cells(1, 21) = TB1.Cells(1, 21)
.Cells(1, 22) = TB1.Cells(1, 22)
.Cells(1, 23) = TB1.Cells(1, 23)
.Cells(1, 24) = TB1.Cells(1, 24)
.Cells(1, 25) = TB1.Cells(1, 25)
.Cells(1, 26) = TB1.Cells(1, 26)
.Cells(1, 27) = TB1.Cells(1, 27)
.Cells(1, 28) = TB1.Cells(1, 28)
.Cells(1, 29) = TB1.Cells(1, 29)
.Cells(1, 30) = TB1.Cells(1, 30)
.Cells(1, 31) = TB1.Cells(1, 31)
.Cells(1, 32) = TB1.Cells(1, 32)
.Cells(1, 33) = TB1.Cells(1, 33)
.Cells(1, 34) = TB1.Cells(1, 34)
.Cells(1, 35) = TB1.Cells(1, 35)
.Cells(1, 36) = TB1.Cells(1, 36)
.Cells(1, 37) = TB1.Cells(1, 37)
LR2 = .Cells(Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 5), .Cells(LR2, 5)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[+1],RC[+1]," & TB1.Name & "!C)" 'Formel 1
.Range(.Cells(2, 5), .Cells(LR2, 5)) = .Range(.Cells(2, 5), .Cells(LR2, 5)).Value        _
' Werte 1
.Range(.Cells(2, 22), .Cells(LR2, 22)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[-16],RC[-16]," & TB1.Name & "!C)" 'Formel 2
.Range(.Cells(2, 22), .Cells(LR2, 22)) = .Range(.Cells(2, 22), .Cells(LR2, 22)).Value    _
' Werte 2
.Range(.Cells(2, 23), .Cells(LR2, 23)).FormulaR1C1 = _
"=SUMIF(" & TB1.Name & "!C[-17],RC[-17]," & TB1.Name & "!C)" 'Formel 3
.Range(.Cells(2, 23), .Cells(LR2, 23)) = .Range(.Cells(2, 23), .Cells(LR2, 23)).Value    _
' Werte 3
For i = 2 To LR2
For j = 2 To LR1
If TB1.Cells(j, 6) = .Cells(i, 6) Then
.Cells(i, 1) = .Cells(i, 1) & TB1.Cells(j, 1) & "; "
.Cells(i, 2) = .Cells(i, 2) & TB1.Cells(j, 2) & "; "
.Cells(i, 3) = .Cells(i, 3) & TB1.Cells(j, 3) & "; "
End If
Next j
.Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 2)                             _
' letzte ; weg
.Cells(i, 2) = Left(.Cells(i, 2), Len(.Cells(i, 2)) - 2)                             _
' letzte ; weg
.Cells(i, 3) = Left(.Cells(i, 3), Len(.Cells(i, 3)) - 2)                             _
' letzte ; weg
Next i
End With
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Hierunter findest du das Ergebnis des Makros (Rote Zelllen = Fehler (bzw. Angabe fehlt), grüne Zellen alles OK)
Userbild

Was hab ich denn übersehen?
VG und Danke im Voraus für deine Mühen
Winfried

Beliebteste Forumthreads (12 Monate)

Alle Zeilen-Nr.s bei partieller Übereinstimmung in

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread