Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Nach Eingabe Werte aus Tabellen Übernehmen

Gruppe

Change

Problem

Wie kann ich je nach Eingabe einer Artikelnummer Werte aus verschiedenen Tabellen übernehmen?

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

ClassModule: Tabelle3

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   Dim wksWaren As Worksheet, wksPlatten As Worksheet
   Dim var As Variant
   Dim iRow As Integer, iCol As Integer
   Set wksWaren = Worksheets("Warenliste")
   Set wksPlatten = Worksheets("Platten")
   If Target.Rows.Count > 1 Then Exit Sub
   If IsEmpty(Target) Then Exit Sub
   Application.EnableEvents = False
   On Error GoTo ERRORHANDLER
   Select Case Target.Column
      Case 1
         If Target.Value <> "AAA" Then
            var = Application.Match( _
               Target.Value, wksWaren.Columns(1), 0)
            If IsError(var) Then
               MsgBox "Artikelnummer nicht gefunden," & _
                  " bitte Neueingabe!"
               Target.ClearContents
               Exit Sub
            End If
            Target.Offset(0, 1) = wksWaren.Cells(var, 2).Value
            Target.Offset(0, 4) = wksWaren.Cells(var, 3).Value
            Target.Offset(1, 0).Select
         Else
            Target.Offset(0, 1) = "Tischlerplatte"
            Target.Offset(0, 2).Select
         End If
      Case 3
            If Target.Offset(0, -2) = "AAA" Then _
               Target.Offset(0, 1).Select
      Case 4
         iRow = WorksheetFunction.Match(Target.Offset(0, -1).Value, _
            wksPlatten.Columns(1))
         iCol = WorksheetFunction.Match(Target.Value, wksPlatten.Rows(3))
         Target.Offset(0, 1).Value = wksPlatten.Cells(iRow, iCol).Value
         Target.Offset(1, -3).Select
   End Select
ERRORHANDLER:
    Application.EnableEvents = True
End Sub