Gruppe
Ereignis
Problem
Wie kann ich je nach Eingabe einer Artikelnummer Werte aus verschiedenen Tabellen übernehmen?
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