Ich brauche an meinem Makro noch den letzten Feinschliff und komme irgendwie nicht auf den richtigen Gedanken.... Sicher könnt ihr mir helfen.
Es geht um eine Artikeldatei, die laufend fortgeschrieben wird. Ich würde gerne überprüfen, ob der Artikel weiter oben schon mal eingegeben wurde. Dann soll
1. in Spalte S der Hinweis "doppelt" stehen und
2. in Spalte AD der Wert stehen, der in der Spalte AD ist, wo der Artikel zuerst vorkommt.
Ich denke mal, dass der Code ziemlich umständlich geschrieben ist, weil ich erst vor kurzem mit VBA angefangen habe. Vielleicht könnt ihr trotzdem helfen.
Ich habe in den letzten beiden Zeilen der Datei ein Beispiel gemacht, wie ich es gerne erreichen würde.
https://www.herber.de/bbs/user/18260.xls
Danke schon mal vorab!!
Gruß,
Melanie
Option Explicit
Sub Schrottliste()
Dim i As Integer
Dim iRow As Integer
Dim iRowL As Integer
Dim wkbQuelle4 As Workbook
Dim wkbQuelle6 As Workbook
Dim wkbBasis As Workbook
Dim wksBasis As Worksheet
Dim bereich As Range
Set wkbBasis = ActiveWorkbook
Set wksBasis = wkbBasis.Worksheets("Tabelle1")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbQuelle4 = Workbooks.Open("M:\Werk7WorkingCapital\Projektcontrolling\Gesamtbestand-aktuell.xls")
Set wkbQuelle6 = Workbooks.Open("M:\et-p\Materialstamm ET\MatStamm-aktuell.xls")
Workbooks("Schrottliste (3).xls").Sheets("Tabelle1").Activate
If IsEmpty(Cells(2, 3)) Then
iRow = 2
Else
iRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
End If
iRowL = ActiveSheet.UsedRange.Rows.Count
Columns(8).NumberFormat = "dd.mm.yyyy"
On Error Resume Next
For i = iRow To iRowL
wksBasis.Cells(i, 3) = Date
wksBasis.Cells(i, 3).NumberFormat = "dd.mm.yyyy"
'Wenn Cells(i,1) leer ist, dann gehe nimm als Verweis Cells(i, 2), ansonsten cells(i,1)
****Hier soll die Prüfung rein:
Wenn der Wert von wksBasis.Cells(i,2) im Bereich iRow bis i-1, Spalte 2 enthalten ist, dann soll in Cells (i,19) "doppelt" stehen und in Cells (i, 30) der Wert der Spalte (?, 30) stehen, dann über next ins nächste i springen ***
If IsEmpty(wksBasis.Cells(i, 1)) Then
wksBasis.Cells(i, 4) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 6, False) 'Disp.Nrn
wksBasis.Cells(i, 5) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 5, False) 'disponenten
wksBasis.Cells(i, 28).Value = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 44, False) 'Versorgungsende LC
If Cells(i, 28).Value = "00.00.0000" Then
Cells(i, 6).Value = "00.00.0000"
Cells(i, 6).Font.ColorIndex = xlAutomatic
Else
Cells(i, 6).Value = "=DATEVALUE(RC[22])"
Cells(i, 6).NumberFormat = "dd.mm.yyyy"
If Cells(i, 6).Value < Date Then
Cells(i, 6).Font.ColorIndex = 3
Else
Cells(i, 6).Font.ColorIndex = xlAutomatic
End If
End If
wksBasis.Cells(i, 7).FormulaR1C1 = "=RC[3]/((RC[6]*0.2)+(RC[7]*0.3)+(RC[8]*0.5))*12"
wksBasis.Cells(i, 7).NumberFormat = "0"
wksBasis.Cells(i, 8).FormulaR1C1 = "=TODAY() + (RC[-1]/12*365)"
wksBasis.Cells(i, 9).FormulaR1C1 = "=IF(RC[-3]=""00.00.0000"",""Prüfung durch Technik"",IF(RC[-1]>RC[-3],""J"",""N""))"
Cells(i, 9).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""J"""
Selection.FormatConditions(1).Font.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=""J"""
Selection.FormatConditions(2).Font.ColorIndex = xlAutomatic
wksBasis.Cells(i, 10) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 16, False) 'Menge
wksBasis.Cells(i, 11) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("gesamtbestand"). _
Range("A1:M35000"), 13, False) 'Preis lt. Steuerung
wksBasis.Cells(i, 12) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 17, False) 'Wert Lagerbestand
wksBasis.Cells(i, 13) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 13, False) 'Verbrauch 2002
wksBasis.Cells(i, 14) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 14, False) 'Verbrauch 2003
wksBasis.Cells(i, 15) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 15, False) 'Verbrauch 2004
wksBasis.Cells(i, 16) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 8, False) 'VStati Inland
wksBasis.Cells(i, 17) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 9, False) 'VStati Export
wksBasis.Cells(i, 18) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 10, False) 'VStati TG
wksBasis.Cells(i, 21).FormulaR1C1 = "=RC[-1]/100*RC[-10]"
wksBasis.Cells(i, 23) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2120"). _
Range("A1:Q35000"), 12, False) 'Bestand 2120
wksBasis.Cells(i, 24) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2140"). _
Range("A1:Q35000"), 12, False) 'Bestand 2140
wksBasis.Cells(i, 25) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2145"). _
Range("A1:Q35000"), 12, False) 'Bestand 2145
wksBasis.Cells(i, 26) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("2185"). _
Range("A1:Q35000"), 12, False) 'Bestand 2185
wksBasis.Cells(i, 27) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 2), wkbQuelle4.Worksheets("5000"). _
Range("A1:Q35000"), 12, False) 'Bestand 5000
Else
wksBasis.Cells(i, 4) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 6, False) 'Disp.Nrn
wksBasis.Cells(i, 5) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 5, False) 'disponenten
wksBasis.Cells(i, 28).Value = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 44, False) 'Versorgungsende LC
If Cells(i, 28).Value = "00.00.0000" Then
Cells(i, 6).Value = "00.00.0000"
Cells(i, 6).Font.ColorIndex = xlAutomatic
Else
Cells(i, 6).Value = "=DATEVALUE(RC[22])"
Cells(i, 6).NumberFormat = "dd.mm.yyyy"
If Cells(i, 6).Value < Date Then
Cells(i, 6).Font.ColorIndex = 3
Else
Cells(i, 6).Font.ColorIndex = xlAutomatic
End If
End If
wksBasis.Cells(i, 7).FormulaR1C1 = "=RC[3]/((RC[6]*0.2)+(RC[7]*0.3)+(RC[8]*0.5))*12"
wksBasis.Cells(i, 7).NumberFormat = "0"
wksBasis.Cells(i, 8).FormulaR1C1 = "=TODAY() + (RC[-1]/12*365)"
wksBasis.Cells(i, 9).FormulaR1C1 = "=IF(RC[-3]=""00.00.0000"",""Prüfung durch Technik"",IF(RC[-1]>RC[-3],""J"",""N""))"
Cells(i, 9).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""J"""
Selection.FormatConditions(1).Font.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=""J"""
Selection.FormatConditions(2).Font.ColorIndex = xlAutomatic
wksBasis.Cells(i, 10) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 16, False) 'Menge
wksBasis.Cells(i, 11) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("gesamtbestand"). _
Range("A1:M35000"), 13, False) 'Preis lt. Steuerung
wksBasis.Cells(i, 12) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("Gesamtbestand ohne Sonderläger"). _
Range("A1:Q35000"), 17, False) 'Wert Lagerbestand
wksBasis.Cells(i, 13) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 13, False) 'Verbrauch 2002
wksBasis.Cells(i, 14) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 14, False) 'Verbrauch 2003
wksBasis.Cells(i, 15) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 15, False) 'Verbrauch 2004
wksBasis.Cells(i, 16) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 8, False) 'VStati Inland
wksBasis.Cells(i, 17) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 9, False) 'VStati Export
wksBasis.Cells(i, 18) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle6.Worksheets("matstwerk7"). _
Range("A1:AV50000"), 10, False) 'VStati TG
wksBasis.Cells(i, 21).FormulaR1C1 = "=RC[-1]/100*RC[-10]"
wksBasis.Cells(i, 23) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2120"). _
Range("A1:Q35000"), 12, False) 'Bestand 2120
wksBasis.Cells(i, 24) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2140"). _
Range("A1:Q35000"), 12, False) 'Bestand 2140
wksBasis.Cells(i, 25) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2145"). _
Range("A1:Q35000"), 12, False) 'Bestand 2145
wksBasis.Cells(i, 26) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("2185"). _
Range("A1:Q35000"), 12, False) 'Bestand 2185
wksBasis.Cells(i, 27) = _
Application.WorksheetFunction.VLookup(wksBasis.Cells(i, 1), wkbQuelle4.Worksheets("5000"). _
Range("A1:Q35000"), 12, False) 'Bestand 5000
End If
Next i
wkbQuelle4.Close False
wkbQuelle6.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub