VBA-Programmierung in Microsoft Excel

Nach Eingabe Werte aus 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

    

Beiträge aus dem Excel-Forum zu den Themen Ereignis und Change