Gruppe
Ereignis
Bereich
Change
Thema
Nach Eingabe Werte aus Tabellen Übernehmen
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