Hallo,
ich habe nachfolgendes Skript geschrieben um aus einer Referenzliste Informationen in Materiallisten zu übertragen wenn eine gewisse Materialnummer übereinstimmt. Das klappt auf einzelnen Blättern, aber bei anderen Tabellenblättern überhaupt nicht. Könnt ihr einen Fehler sehen? Die Materialunterblätter sind alle identisch.
Sub Abgleich_Referenmaterial()
'strg + g
' Dim intStart_StrukturZeile As Integer: intStart_StrukturZeile = 10
' Dim intStart_StrukturSpalte As Integer: intStart_StrukturSpalte = 12
Dim letzteSpalte_current As Integer: letzteSpalte_current = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Dim letzteZeile_current As Integer: letzteZeile_current = ActiveSheet.Cells(1048576, 11).End(xlUp).Row
Dim letzteSpalte_Ref As Integer: letzteSpalte_Ref = ThisWorkbook.Worksheets("Referenzmaterial").UsedRange.SpecialCells(xlCellTypeLastCell).Column
Dim letzteZeile_Ref As Integer: letzteZeile_Ref = ThisWorkbook.Worksheets("Referenzmaterial").Cells(1048576, 3).End(xlUp).Row
Dim strSupplier As String: strSupplier = ""
''''''''''''''''''''''''''''''''''''''''''''''''
'''' Befüllen der Struktur '''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
For i = 4 To letzteZeile_current
If Len(ActiveSheet.Range("K" & CStr(i)).Value) >= 1 Then
For j = 1 To letzteSpalte_Ref
If InStr(ThisWorkbook.Worksheets("Referenzmaterial").Range("C" & CStr(j)).Value, ActiveSheet.Range("K" & CStr(i)).Value) > 0 Then
'TKZ-neu
ActiveSheet.Range("P" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("L" & CStr(j)).Value
'Warengruppe
ActiveSheet.Range("M" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("W" & CStr(j)).Value
'Komplexität
ActiveSheet.Range("N" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("K" & CStr(j)).Value
'Geplante Lieferanten
strSupplier = ThisWorkbook.Worksheets("Referenzmaterial").Range("Q" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("R" & CStr(j)).Value & ") / " & ThisWorkbook.Worksheets("Referenzmaterial").Range("S" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("T" & CStr(j)).Value & ") / " & ThisWorkbook.Worksheets("Referenzmaterial").Range("U" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("V" & CStr(j)).Value & ")"
ActiveSheet.Range("Q" & CStr(i)).Value = strSupplier
strSupplier = ""
'setzen, dass verwendetes Ref-Material ja
ThisWorkbook.Worksheets("Referenzmaterial").Range("A" & CStr(j)).Value = "ja"
' beenden, wenn gefunden und nächstes Material
Exit For
End If
Next
End If
Next
End Sub
Vielen Dank.
Gruß, David.
|