Mehrstufige Strukturstückliste

Bom · 2014-01-25T02:17:41+00:00

Hallo VBA-Freunde, ich versuche mich gerade an verschiedenen Stücklistenproblematiken und bin bei der Auflösung der einer mehrstufigen Stückliste leider an meine Grenzen gestossen. Die Idee hinter dem rekursiven Aufruf der auflösenden Funktion ist mir verständlich. Wie man das aber vernünftig in einen Code bringen kann leider nicht. Ich habe mir im Netz schon die Augen wund gesucht, konnte aber keine grundsätzliche Erläuterung finden. Meine Ausgangsbasis im Blatt "Urdaten" die ich habe sieht so aus: A B C Teil Stückliste Anbaukomponente 1111 11111 1112 1111 11111 1113 1111 11111 1114 1111 11111 1115 1111 11111 1116 1111 11111 1117 1112 11112 1118 1112 11112 1119 1112 11112 1120 1112 11112 1121 1112 11112 1122 1114 11114 1123 1114 11114 1124 1114 11114 1125 1114 11114 1126 1114 11114 1127 1124 11124 1128 1124 11124 1129 1124 11124 1130 1124 11124 1131 1124 11124 1132 1132 11132 1133 1132 11132 1134 1132 11132 1135 1132 11132 1136 Das übergeordnete Teil 1111 hat wiederum Teile, die selbst aus mehreren Komponenten bestehen können. Ziel ist es der SAP-Transaktion CS-12 gleich eine Strukturstückliste in Blatt "Auflösung" aufzubauen: A B Stufe Teil .1 1111 ..2 1112 ...3 1118 ...3 1119 ...3 1120 ...3 1121 ...3 1122 ..2 1113 ..2 1114 ...3 1123 ...3 1124 .4 1128 .4 1129 .4 1130 .4 1131 .4 1132 ..5 1133 ..5 1134 ..5 1135 ..5 1136 ...3 1126 ...3 1127 ..2 1115 ..2 1116 ..2 1117 Falls der aufmerksame Leser sich fragt wozu Excel wenn es schon in SAP gibt: ich habe mir einen Code gebastelt, der mir den Stufenwert der Material und Fertigungskosten ausgibt. Wenn ich jetzt die Strukturstückliste mit diesem Code vereine dann erhalte ich bei Eingabe einer Teilenummer eine Strukturstückliste mit den einzelnen Stufen und dazugehörigen Stufenwerten. Über Hilfe, Anregungen oder Anleitung wäre ich sehr dankbar :) Grüße

Hallo Bill of Materials Missversteher,
hier ein Makro, das die Struktur entsprechend auflöst.
Gruß
Franz

'Code in einem allgemeinen Modul
'Erstellt unter Excel 2010 - 2014-01-25
Option Explicit
Public wksUrsprung As Worksheet
Public wksAuf As Worksheet
Public Zeile_A As Long, Zeile_UL As Long
Private Const bolPunkt As Boolean = False 'wenn True, dann werden Punkte vor der Stufe eingefü _
gt
Sub SAP_Struktur()
'AUflösen der Stücklisten in SAP-Struktur
Dim varTeil_1, Zeile_U As Long, Zeile_U2 As Long, rngKomp As Range
Dim arrDone() As Boolean
Const Zeile_A1 As Long = 2 ' 1. Datemzeile für aufgelöste Struktur im Blatt "Auflösung"
Set wksUrsprung = Worksheets("Urdaten")
Set wksAuf = Worksheets("Auflösung")
Application.ScreenUpdating = False
'Altdaten löschen im Blatt "Auflösung"
With wksAuf
Zeile_A = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_A >= Zeile_A1 Then
.Range(.Rows(Zeile_A1), .Rows(Zeile_A)).ClearContents
End If
Zeile_A = Zeile_A1 - 1
End With
With wksUrsprung
'letzte Zeile in Spalte A in Ursprungsblatt
Zeile_UL = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim arrDone(1 To Zeile_UL)
For Zeile_U = 2 To Zeile_UL
'erledigte Zeilen der Stufe 1 überspringen
If arrDone(Zeile_U) = False Then
varTeil_1 = .Cells(Zeile_U, 1)
'prüfen, ob Teil unter Komponenten vorhanden
Set rngKomp = .Columns(3).Find(what:=varTeil_1, LookIn:=xlValues, lookat:=xlWhole)
If rngKomp Is Nothing Then 'Teil der Stufe 1
'Teil in Auflösung als Stufe 1 eintragen
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'." & 1, 1) 'Stufe = 1
wksAuf.Cells(Zeile_A, 2) = varTeil_1
'Alle Unterkomponenten dieses Teils bis zum Ende der Liste abarbeiten
For Zeile_U2 = Zeile_U To Zeile_UL
If varTeil_1 = .Cells(Zeile_U2, 1) Then
'Struktur der Unterkomponente abarbeiten
Call prcFindStufen(varKomponente:=.Cells(Zeile_U2, 3), Stufe:=2)
arrDone(Zeile_U2) = True 'Teil als erledigt markieren
End If
Next Zeile_U2
End If
End If
Next Zeile_U
End With
Application.ScreenUpdating = True
Erase arrDone
End Sub
Sub prcFindStufen(ByVal varKomponente, ByVal Stufe)
Dim rngTeil As Range, Zeile_U As Long
With wksUrsprung
'Prüfen, ob die Unterkomponente in Spalte A als Teil vorkommt.
Set rngTeil = .Columns(1).Find(what:=varKomponente, After:=.Cells(1, 1), LookIn:=xlValues,  _
_
lookat:=xlWhole)
If rngTeil Is Nothing Then
'keine weiteren Unterkomponenten
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'" & String(Stufe, ".") & Stufe, Stufe)
wksAuf.Cells(Zeile_A, 2) = varKomponente
Else
'Unterkomponente mit Stufe eintragen
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'" & String(Stufe, ".") & Stufe, Stufe)
wksAuf.Cells(Zeile_A, 2) = varKomponente
'Unterkomponenten zur Unterkomponente abarbeiten
For Zeile_U = rngTeil.Row To Zeile_UL
If rngTeil.Value = .Cells(Zeile_U, 1) Then
Call prcFindStufen(varKomponente:=.Cells(Zeile_U, 3), Stufe:=Stufe + 1)
End If
Next
End If
End With
End Sub

Hallo Konrad,
das Abarbeiten eines Arrays von Stücklistennummern, die nicht ausgewertet werden sollen ist möglich. Es erfordert aber ein paar Anpassungen und eine Prüffunktion, die das Array abarbeitet.
In der Prozedur MakeSAP_Struktur muss dann das Array mit den Stücklisten-Nummern gefüllt werden.
Gruß
Franz

'Code in einem allgemeinen Modul
'Erstellt unter Excel 2010 - 2014-01-26
Option Explicit
Public wksUrsprung As Worksheet
Public wksAuf As Worksheet
Public Zeile_A As Long, Zeile_UL As Long
Private Const bolPunkt As Boolean = True 'wenn True, dann werden Punkte vor der Stufe eingefügt
Public parrNot_SL_Nr()   'Teile mit dieser Stücklisten-Nummer nicht in Struktur listen
Sub Make_SAP_Struktur()
Dim intI As Integer
'Array mit nicht zu übernehmenden Stücklisten zurücksetzen
Erase parrNot_SL_Nr
'Array mit Nummern füllen - z.B in einer Schleife
'hier musst du dann was passendes einbauen
intI = intI + 1
ReDim Preserve parrNot_SL_Nr(1 To intI)
parrNot_SL_Nr(intI) = 99999
intI = intI + 1
ReDim Preserve parrNot_SL_Nr(1 To intI)
parrNot_SL_Nr(intI) = 22222
'Struktur erstellen
Call SAP_Struktur
End Sub
Sub SAP_Struktur()
'AUflösen der Stücklisten in SAP-Struktur
Dim varTeil_1, Zeile_U As Long, Zeile_U2 As Long, rngKomp As Range
Dim arrDone() As Boolean
Const Zeile_A1 As Long = 2 ' 1. Datemzeile für aufgelöste Struktur im Blatt "Auflösung"
Set wksUrsprung = Worksheets("Urdaten")
Set wksAuf = Worksheets("Auflösung")
Application.ScreenUpdating = False
'Altdaten löschen im Blatt "Auflösung"
With wksAuf
Zeile_A = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_A >= Zeile_A1 Then
.Range(.Rows(Zeile_A1), .Rows(Zeile_A)).ClearContents
End If
Zeile_A = Zeile_A1 - 1
End With
With wksUrsprung
'letzte Zeile in Spalte A in Ursprungsblatt
Zeile_UL = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim arrDone(1 To Zeile_UL)
For Zeile_U = 2 To Zeile_UL
'erledigte Zeilen der Stufe 1 und  überspringen
If arrDone(Zeile_U) = False And fncNotSL(.Cells(Zeile_U, 2)) = False Then
varTeil_1 = .Cells(Zeile_U, 1)
'prüfen, ob Teil unter Komponenten vorhanden
Set rngKomp = .Columns(3).Find(What:=varTeil_1, LookIn:=xlValues, lookat:=xlWhole)
If rngKomp Is Nothing Then 'Teil der Stufe 1
'Teil in Auflösung als Stufe 1 eintragen
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'." & 1, 1) 'Stufe = 1
wksAuf.Cells(Zeile_A, 2) = varTeil_1
'Alle Unterkomponenten dieses Teils bis zum Ende der Liste abarbeiten
For Zeile_U2 = Zeile_U To Zeile_UL
If varTeil_1 = .Cells(Zeile_U2, 1) And fncNotSL(.Cells(Zeile_U2, 2)) = False Then
'Struktur der Unterkomponente abarbeiten
Call prcFindStufen(varKomponente:=.Cells(Zeile_U2, 3), Stufe:=2)
arrDone(Zeile_U2) = True 'Teil als erledigt markieren
End If
Next Zeile_U2
End If
End If
Next Zeile_U
End With
Application.ScreenUpdating = True
Erase arrDone
End Sub
Sub prcFindStufen(ByVal varKomponente, ByVal Stufe)
Dim rngTeil As Range, Zeile_U As Long
With wksUrsprung
'Prüfen, ob die Unterkomponente in Spalte A als Teil vorkommt.
Set rngTeil = .Columns(1).Find(What:=varKomponente, After:=.Cells(1, 1), LookIn:=xlValues,  _
_
lookat:=xlWhole)
If rngTeil Is Nothing Then
'keine weiteren Unterkomponenten
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'" & String(Stufe, ".") & Stufe, Stufe)
wksAuf.Cells(Zeile_A, 2) = varKomponente
Else
'Unterkomponente mit Stufe eintragen
Zeile_A = Zeile_A + 1
wksAuf.Cells(Zeile_A, 1) = IIf(bolPunkt, "'" & String(Stufe, ".") & Stufe, Stufe)
wksAuf.Cells(Zeile_A, 2) = varKomponente
'Unterkomponenten zur Unterkomponente abarbeiten
For Zeile_U = rngTeil.Row To Zeile_UL
If rngTeil.Value = .Cells(Zeile_U, 1) And fncNotSL(.Cells(Zeile_U, 2)) = False Then
Call prcFindStufen(varKomponente:=.Cells(Zeile_U, 3), Stufe:=Stufe + 1)
End If
Next
End If
End With
End Sub
Public Function fncNotSL(varSL) As Boolean
'Prüft ob Strücklisten-Nr in der Liste der nicht auszuwerten Nummern ist
Dim intI As Integer
fncNotSL = False
On Error GoTo Beenden 'Array enthält keine Nummern
For intI = LBound(parrNot_SL_Nr) To UBound(parrNot_SL_Nr)
If varSL = parrNot_SL_Nr(intI) Then
fncNotSL = True
Exit For
End If
Next intI
Beenden:
Err.Clear
End Function

Forumthread: Mehrstufige Strukturstückliste

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial