Clever-Excel-Forum - mehrere Suchtreffer zu einem Wert

Seiten: 1 2

Hallo Aqui,

keine Datei im Anhang!?

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

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.

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

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!
]

Wahnsinn ... Tausend Dank atilla !!

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

Du hast mir echt das Leben erleichtert :18:

Seiten: 1 2