Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Bestandsführung für 2 Läger

Gruppe

ComboBox

Problem

Wie kann ich per Dialog die Bestände von 2 Lägern führen?

Lösung
Geben Sie den nachfolgenden Code in das Klassenmodul der UserForm ein.

ClassModule: frmLager

Private Sub cboArtikel_Change()
   Dim wks As Worksheet
   Dim iRow As Integer
   If optLagerA.Value = True Then
      Set wks = Worksheets("Lager1")
   Else
      Set wks = Worksheets("Lager2")
   End If
   If cboArtikel.ListIndex = -1 Then
      txtStueck.Text = ""
   Else
      iRow = WorksheetFunction.Match( _
         cboArtikel.Value, wks.Columns(1), 0)
      txtStueck.Text = wks.Cells(iRow, 2).Value
   End If
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   Dim wks As Worksheet
   Dim iRow As Integer
   If optLagerA.Value = True Then
      Set wks = Worksheets("Lager1")
   Else
      Set wks = Worksheets("Lager2")
   End If
   If cboArtikel.ListIndex = -1 Then
      iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
   Else
      iRow = WorksheetFunction.Match( _
         cboArtikel.Value, wks.Columns(1), 0)
   End If
   wks.Cells(iRow, 1).Value = cboArtikel.Value
   If optEingang.Value = True Then
      wks.Cells(iRow, 2).Value = _
         wks.Cells(iRow, 2).Value + CDbl(txtStueck.Text)
   Else
      wks.Cells(iRow, 2).Value = _
         wks.Cells(iRow, 2).Value - CDbl(txtStueck.Text)
   End If
   txtStueck.Text = wks.Cells(iRow, 2).Value
End Sub

Private Sub optLagerA_Change()
   Call optLager_Change
End Sub

Private Sub optLagerB_Change()
   Call optLager_Change
End Sub

Private Sub optLager_Change()
   Dim wks As Worksheet
   Dim iRow As Integer
   cboArtikel.Clear
   If optLagerA.Value = True Then
      Set wks = Worksheets("Lager1")
   Else
      Set wks = Worksheets("Lager2")
   End If
   iRow = 2
   With cboArtikel
      Do Until IsEmpty(wks.Cells(iRow, 1))
         .AddItem wks.Cells(iRow, 1).Value
         iRow = iRow + 1
      Loop
      If .ListCount > 0 Then
         .ListIndex = 0
      End If
   End With
End Sub

StandardModule: basMain

Sub CallForm()
   If ActiveSheet.Name = "Lager1" Then
      frmLager.optLagerA.Value = True
   Else
      frmLager.optLagerB.Value = True
   End If
   frmLager.Show
End Sub