Kopieren in Bezug zum aktuellsten Datum in einem Bereich

[Elex]

Hi,
 
habe deine Datei bekommen. Formatiere bitte in Tab1(Build) die ganzen Spalten 4, 7, 10 als Datum und 3, 5, 6, 8, 9 als Standard. Code ausführen. Sollte erst mal anders aussehen.
 
Leider hast du nicht erwähnt dass die zweite Bedingung aus meinem Beitrag #9 doch auch vorkommt. Muss ich noch anpassen. Wird aber erst Morgen Vormittag.
 
Gruß Elex

[Bamane]

Hi Elex, 

vielen Dank für den Tipp und entschuldige bitte, habe es übersehen. 

Gruss
Bamane

[Elex]

Hi

Hier der Code für Übereinstimmung beider Spalten (Component und Component Description) mit (Material Ve und Short Text).

Code:

Public Sub Liste()
Dim objDict As Object
Dim ArrTab1, ArrTab2 As Variant
Dim LetzA, n, z As Long

LetzA = Sheets("Build Master").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Build Master").Range("C2:J" & LetzA).ClearContents
ArrTab1 = Sheets("Build Master").Range("A1:J" & LetzA).Value
ArrTab2 = Sheets("Prices & Deliv. date").Range("E1:M" & Sheets("Prices & Deliv. date").Cells(Rows.Count, 5).End(xlUp).Row)

Set objDict = CreateObject("Scripting.Dictionary")
For n = 2 To LetzA
    If objDict.exists(ArrTab1(n, 1) & ArrTab1(n, 2)) Then
        MsgBox "Code abgebrochen! Doppelte in Tab1 " & ArrTab1(n, 1) & " / " & ArrTab1(n, 2)
        Exit Sub
    Else
       objDict(ArrTab1(n, 1) & ArrTab1(n, 2)) = n
    End If
Next n

For n = 2 To UBound(ArrTab2, 1)
 If objDict.exists(ArrTab2(n, 1) & ArrTab2(n, 2)) Then
   z = objDict(ArrTab2(n, 1) & ArrTab2(n, 2))    'Die Zeile in Tab1(AB) mit Wert von Tab2(EF)
 'Aktuell
    If ArrTab1(z, 4) < ArrTab2(n, 5) Then  'Datum vergleich
        ArrTab1(z, 4) = ArrTab2(n, 5)
        ArrTab1(z, 3) = ArrTab2(n, 9)
    End If
 'Max
    If ArrTab1(z, 5) = ArrTab2(n, 7) Then  'Qty vergleich
        If ArrTab1(z, 7) < ArrTab2(n, 5) Then  'Datum vergleich
           ArrTab1(z, 6) = ArrTab2(n, 9)
           ArrTab1(z, 7) = ArrTab2(n, 5)
         End If
    Else
        If ArrTab1(z, 5) < ArrTab2(n, 7) Then  'Qty vergleich
           ArrTab1(z, 5) = ArrTab2(n, 7)
           ArrTab1(z, 6) = ArrTab2(n, 9)
           ArrTab1(z, 7) = ArrTab2(n, 5)
        End If
    End If
 'Min
    If ArrTab1(z, 8) = ArrTab2(n, 7) Then  'Qty vergleich
        If ArrTab1(z, 10) < ArrTab2(n, 5) Then  'Datum vergleich
           ArrTab1(z, 9) = ArrTab2(n, 9)
           ArrTab1(z, 10) = ArrTab2(n, 5)
         End If
    Else
        If ArrTab1(z, 8) > ArrTab2(n, 7) Or ArrTab1(z, 8) = "" Then  'Qty vergleich
           ArrTab1(z, 8) = ArrTab2(n, 7)
           ArrTab1(z, 9) = ArrTab2(n, 9)
           ArrTab1(z, 10) = ArrTab2(n, 5)
        End If
    End If
 End If
Next n

Sheets("Build Master").Range("A1").Resize(LetzA, 10) = ArrTab1

Set objDict = Nothing
End Sub

Gruß über den Teich.

[Bamane]

Hi Elex,

vielen Dank, jetzt funktioniert alles. :)
Das Hauptproblem war, dass die Formate nicht richtig festgelegt wurden und deswegen das Datum falsch angezeigt wurde. 

Wünsche dir einen enspannten Tag.

Beste Grüsse 
Bamane