Lagerbuchhaltung, Plus Minus Problem
07.05.2014 10:29:17
Marco
Da ich hier keine Bilder hochladen kann versuche ich es rasch zu umschreiben.
Die Userform hat oben eine Combobox, mit welcher der Lieferant aus dem Adress stamm ausgewählt werden kann.
Dann hab ich unten 10 Zeilen mit TextBoxen in einer Reihe.
Spalte 1 = TextBoxA + Zeilennummer = Lieferanten Nummer(diese Wird automatisch vergeben nachdem der Lieferant über die Combobox vergeben wurde)
Spalte 2 = TextBoxB + Zeilennummer = Artikelnummer des Lieferanten
Spalte 3 = TextBoxG + Zeilennummer = unsere Artikelnummer (zusammengesetzt aus Lieferantennr und Artikel Nummer des Lieferanten zb: 002-50003, wird automatisch zusammengesetzt wenn die TextBoxB verlassen wird)
Spalte 4 = TextBoxC + Zeilennummer = Beschrieb welcher im Artikelstamm zu der Nummer hinterlegt ist. (nicht veränderbar)
Spalte 5 = TextBoxD + Zeilennummer = Aktueller Anzahl im Lager (nicht veränderbar)
Spalte 6 = TextBoxE + Zeilennummer = TextBox zum eintragen der Minus Werte
Spalte 7 = TextboxF + Zeilennummer = TextBox zum eintragen des Materials zuwachs
Unten sind noch zwei CB einer zum Buchen und einer zum Schliessen.
Der Unten angehängte Code habe ich schon.
Den zweiten unten angehängten Code, verwende ich in einer Multipage Seite, welche immer geöffnet bleibt um rasch einen einzeln Artikel zu ändern
Mein Problem ist, wie kreiere ich einen Code für CBBuchen, um automatisch alle Werte der jeweiligen Zeile dazu oder abzurechnen.
Ist es möglich meinen Code zu vereinfachen.
Besten Dank für eure Hilfe
Code 1, Code der Userform, Buchen von mehreren Artikel:
Private Sub CBHide_Click()
Unload Me
End Sub
Dim c As Range
Set objDic = CreateObject("Scripting.Dictionary")
For Each c In wks.Range(wks.Cells(2, lngspalte), wks.Cells(wks.Cells(Rows.Count, lngspalte).End(xlUp).Row, lngspalte))
objDic(Left(c.Value, 20)) = 0
Next
unikate = objDic.Count > 0
If unikate = True Then vntout = objDic.keys
End Function
Private Sub CBneuLieferant_Click()
Lieferanten.Show
End Sub
Private Sub Userform_Initialize()
Dim vntin As Variant
If unikate(Worksheets("Lieferanten"), 3, vntin) Then ComboBox1.List = vntin
End Sub
Private Sub ComboBox1_Click()
Dim i As Long
For i = 1 To 10
Me.Controls("TextboxA" & CStr(i)).Text = Worksheets("Lieferanten").Cells(ComboBox1.ListIndex + _
2, "A").Value
Next i
End Sub
Private Sub TextboxB1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA1)
If Laenge = 1 Then TextBoxG1.Text = "00" & TextBoxA1.Text & "-" & TextBoxB1.Text
If Laenge = 2 Then TextBoxG1.Text = "0" & TextBoxA1.Text & "-" & TextBoxB1.Text
TextBoxA1.Text = ""
TextBoxB1.Text = ""
If Len(Trim(TextBoxG1)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG1, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC1.Text = .Cells(rng.Row, 3)
TextBoxD1.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA2)
If Laenge = 1 Then TextBoxG2.Text = "00" & TextBoxA2.Text & "-" & TextBoxB2.Text
If Laenge = 2 Then TextBoxG2.Text = "0" & TextBoxA2.Text & "-" & TextBoxB2.Text
TextBoxA2.Text = ""
TextBoxB2.Text = ""
If Len(Trim(TextBoxG2)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG2, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC2.Text = .Cells(rng.Row, 3)
TextBoxD2.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA3)
If Laenge = 1 Then TextBoxG3.Text = "00" & TextBoxA3.Text & "-" & TextBoxB3.Text
If Laenge = 2 Then TextBoxG3.Text = "0" & TextBoxA3.Text & "-" & TextBoxB3.Text
TextBoxA3.Text = ""
TextBoxB3.Text = ""
If Len(Trim(TextBoxG3)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG3, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC3.Text = .Cells(rng.Row, 3)
TextBoxD3.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA4)
If Laenge = 1 Then TextBoxG4.Text = "00" & TextBoxA4.Text & "-" & TextBoxB4.Text
If Laenge = 2 Then TextBoxG4.Text = "0" & TextBoxA4.Text & "-" & TextBoxB4.Text
TextBoxA4.Text = ""
TextBoxB4.Text = ""
If Len(Trim(TextBoxG4)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG4, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC4.Text = .Cells(rng.Row, 3)
TextBoxD4.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA5)
If Laenge = 1 Then TextBoxG5.Text = "00" & TextBoxA5.Text & "-" & TextBoxB5.Text
If Laenge = 2 Then TextBoxG5.Text = "0" & TextBoxA5.Text & "-" & TextBoxB5.Text
TextBoxA5.Text = ""
TextBoxB5.Text = ""
If Len(Trim(TextBoxG5)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG5, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC5.Text = .Cells(rng.Row, 3)
TextBoxD5.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA6)
If Laenge = 1 Then TextBoxG6.Text = "00" & TextBoxA6.Text & "-" & TextBoxB6.Text
If Laenge = 2 Then TextBoxG6.Text = "0" & TextBoxA6.Text & "-" & TextBoxB6.Text
TextBoxA6.Text = ""
TextBoxB6.Text = ""
If Len(Trim(TextBoxG6)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG6, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC6.Text = .Cells(rng.Row, 3)
TextBoxD6.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA7)
If Laenge = 1 Then TextBoxG7.Text = "00" & TextBoxA7.Text & "-" & TextBoxB7.Text
If Laenge = 2 Then TextBoxG7.Text = "0" & TextBoxA7.Text & "-" & TextBoxB7.Text
TextBoxA7.Text = ""
TextBoxB7.Text = ""
If Len(Trim(TextBoxG7)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG7, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC7.Text = .Cells(rng.Row, 3)
TextBoxD7.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA8)
If Laenge = 1 Then TextBoxG8.Text = "00" & TextBoxA8.Text & "-" & TextBoxB8.Text
If Laenge = 2 Then TextBoxG8.Text = "0" & TextBoxA8.Text & "-" & TextBoxB8.Text
TextBoxA8.Text = ""
TextBoxB8.Text = ""
If Len(Trim(TextBoxG8)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG8, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC8.Text = .Cells(rng.Row, 3)
TextBoxD8.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB9_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA9)
If Laenge = 1 Then TextBoxG9.Text = "00" & TextBoxA9.Text & "-" & TextBoxB9.Text
If Laenge = 2 Then TextBoxG9.Text = "0" & TextBoxA9.Text & "-" & TextBoxB9.Text
TextBoxA9.Text = ""
TextBoxB9.Text = ""
If Len(Trim(TextBoxG9)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG9, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC9.Text = .Cells(rng.Row, 3)
TextBoxD9.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Private Sub TextboxB10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Laenge As Long
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
Laenge = Len(Me.TextBoxA10)
If Laenge = 1 Then TextBoxG10.Text = "00" & TextBoxA10.Text & "-" & TextBoxB10.Text
If Laenge = 2 Then TextBoxG10.Text = "0" & TextBoxA10.Text & "-" & TextBoxB10.Text
TextBoxA10.Text = ""
TextBoxB10.Text = ""
If Len(Trim(TextBoxG10)) = 0 Then Exit Sub
ReDim vtmp(0)
With Sheets("Artikelstamm")
Set rng = .Range("A:Z").Find(what:=TextBoxG10, lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
TextBoxC10.Text = .Cells(rng.Row, 3)
TextBoxD10.Text = .Cells(rng.Row, 13)
End If
Set rng = .Range("A:Z").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
Set rng = Nothing
End Sub
Code zwei, aus der Multipage,
Private Sub Plus_click()
Dim intZ As Integer
Dim SN
Dim c As Range
SN = TextBox2.Value
Set c = Sheets("Artikelstamm").Columns(2).Find(SN)
If Not c Is Nothing Then
intZ = c.Row
With Sheets("Artikelstamm")
.Cells(intZ, 13) = .Cells(intZ, 13) + TextBox6
End With
End If
Artikel_Suche
End Sub
Private Sub Minus_click()
Dim intZ As Integer
Dim SN
Dim c As Range
SN = TextBox2.Value
Set c = Sheets("Artikelstamm").Columns(2).Find(SN)
If Not c Is Nothing Then
intZ = c.Row
With Sheets("Artikelstamm")
.Cells(intZ, 13) = .Cells(intZ, 13) - TextBox6
End With
End If
Artikel_Suche
End Sub