mehrere Suchtreffer zu einem Wert

[atilla]

Hallo Aqui,


keine Datei im Anhang!?

[Aqui]

:19:  sorry ... eingefügt aber nicht hochgeladen, ist jetzt drin ...

[atilla]

Hallo Aqui,

teste folgenden Code:

Code:

Sub mach()
Dim i As Long, j As Long, k As Long
Dim Sp
Dim lngZ As Long
Dim Paketliste As Range

Set Paketliste = Cells(3, 6).CurrentRegion
Paketliste.Cells(1, 1).Offset.Resize(, Paketliste.Columns.Count).Select

Application.ScreenUpdating = False
Columns("R:U").Clear
j = 3
For i = 2 To Cells(1).CurrentRegion.Rows.Count
  Sp = Application.Match(Cells(i, 3) & "*", Paketliste.Cells(1, 1).Offset.Resize(, Paketliste.Columns.Count), 0)
  If IsNumeric(Sp) Then
    lngZ = Cells(Rows.Count, Sp + 5).End(xlUp).Row
    Cells(3, Sp + 5).Resize(lngZ - 2, 2).Copy Cells(j, 20)
    For k = 1 To lngZ - 2
      Cells(j + k - 1, 21) = Cells(i, 4).Value * Cells(j + k - 1, 21).Value
    Next k
    Range(Cells(j, 18), Cells(j + lngZ - 3, 19)).Value = Range(Cells(i, 1), Cells(i, 2)).Value
    j = j + lngZ - 2
  Else
    Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = 3 'Hier werden die Spalten 1 bis 4 in der Zeile rot gefärbt, wenn ein Auftrag in Liste2 nicht gefunden wird, kann gelöscht werden wenn nicht benötigt
  End If
  'ab hier werden unter den Blöcken dicke Rahmenlinien gezeichnet (blöcke mit unerschiedlichen Auftragsnummern werden getrennt)
  If Cells(i, 2) <> Cells(i + 1, 2) Then
    With Range(Cells(j - 1, 18), Cells(j - 1, 21)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
  End If
  'bis hier Code für die Linien, wenn nicht gebraucht wird, den Code Block löschen
Next i
Range("R2:U2") = Array("Kd.Nr.", "Auftrag", "Paket Nr.", "Menge")
Application.ScreenUpdating = True
End Sub

Vorgaben:
-Liste1 hat in Zeile 1 Überschriften und die Daten befinden sich ohne Leerzeilen ab Zeile 2 (Bereich ab Zelle A1)
-Liste2 beginnt ab Zelle F2 Die Zellen in Zeile 1 über F2 sind leer (keine Beschreibung "Ausgangsliste etc"

so sieht die Ausgangssituation aus:

[
Bild bitte so als Datei hochladen: Klick mich!
]

Beide Listen werden dynamisch eingelesen. Bei Erweiterung der Listen braucht nichts am Code angepasst werden.
Liste 1 ist nach unten dynamisch
Liste 2 ist nach rechts und unten dynamisch

Lies Dir auch die Kommentare im Code durch.

[Aqui]

Hallo Atilla,

ich glaube ich habe dich wohl etwas auf einen falschen Weg gebracht, entschuldige bitte.

Das Endresultat sollte wie in Mappe 2 sein (Spalte M-P), nur das ich die Daten (F-I) etwas erweitert habe um Spalte J-M).
Eine Anreicherung der Daten:
In Mappe 3 Habe ich jetzt in der Spalte P-S die ersten beiden als Beispiel manuell reingeschrieben

1. Suche nach dem Kunden / Auftrag / Produkt
2. ergänze alle Werte, die zu dem Produkt gehören aus der Ausgang-liste 2

vielleicht wird es aus dem zweiten Kunden / Auftrag (13991 / A310630) deutlich

Grüße
Aqui

[atilla]

Hallo Aqui,

mach doch einfach das, was ich Dir geschrieben habe.

lösch' über der Ausgangsliste 2 die Benennung "Ausgangs-Liste 2" und führ den Code mal aus



So sieht dann die Zielliste bei mir aus (geschrieben in Spalte R-U)

[
Bild bitte so als Datei hochladen: Klick mich!
]


und so jetzt mit Mappe3

[
Bild bitte so als Datei hochladen: Klick mich!
]

[Aqui]

Wahnsinn ... Tausend Dank atilla !!


Jetzt kämpfe ich mich durch um es auch noch zu verstehen.

Du hast mir echt das Leben erleichtert :18: