Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Eingabe der Artikelnummer und Rabattberechnung

Gruppe

Change

Problem

Wie kann ich durch die Eingabe einer Artikelnummer den Import der Warenbenennung und des Preises aus anderen Tabellenblätter veranlassen? Bei den preisen soll eine Rabattberechnung anhand einer vorhandenen Rabatt-Tabelle vorgenommen werden.

Lösung
Geben Sie den Ereigniscode in das Klassenmodul des Arbeitsblattes ein.

ClassModule: Tabelle2

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim wks As Worksheet, wksRabatt As Worksheet
   Dim varArtikel As Variant, varRabatt As Variant
   Dim dValue As Double, dNetto As Double
   Dim iWks As Integer
   If Target.Column <> 1 Then Exit Sub
   If IsEmpty(Target) Then Exit Sub
   If Target.Cells.Count > 1 Then Exit Sub
   Set wksRabatt = Worksheets("Rabatt")
   For iWks = 3 To 5
      varArtikel = Application.Match(Target.Value, Worksheets(iWks).Columns(1), 0)
      If Not IsError(varArtikel) Then
         Set wks = Worksheets(iWks)
         Exit For
      End If
   Next iWks
   If IsError(varArtikel) Then
      Exit Sub
   Else
      dValue = wks.Cells(varArtikel, 3).Value
      varRabatt = Application.Match(wks.Name, wksRabatt.Columns(4), 0)
      If Not IsError(varRabatt) Then
         dValue = dValue - (dValue * wksRabatt.Cells(varRabatt, 5).Value / 100)
      End If
      varRabatt = Application.Match(Target.Value, wksRabatt.Columns(1), 0)
      If Not IsError(varRabatt) Then
         dValue = dValue - (dValue * wksRabatt.Cells(varRabatt, 2).Value / 100)
      End If
      Target.Offset(0, 1).Value = wks.Cells(varArtikel, 2).Value
      Target.Offset(0, 2).Value = dValue
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub