AW: Werte Mittels eines Codes einlesen
28.03.2013 15:43:40
fcs
Hallo Wolfgang,
hier ein Makro, das die eingegebenen Gapcodes sucht und die zugehörigen Werte überträgt.
Damit die führenden Nullen korrekt übernommen werden, müssen die Zellen in den Spalten mit FY, LY und MB als Text formatiert werden.
Gruß
Franz
Option Explicit
'Code im VBA-Editor unter dem Blatt "Neue Teilenummer laden"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varGapsCode As Variant, rngZelle As Range
Dim wksGapsCode As Worksheet, Zeile As Long
Dim wksTNR As Worksheet
Set wksGapsCode = Worksheets("Gapscode")
Set wksTNR = Me
If Target.Column = 17 And Target.Row > 1 And Target.Cells.Count = 1 Then
varGapsCode = Target.Value
With wksGapsCode
Set rngZelle = .Columns(1).Find(What:=varGapsCode, LookIn:=xlValues, lookat:=xlWhole)
If rngZelle Is Nothing Then
MsgBox "Eingegben GapsCode ist in Liste nicht vorhanden"
Else
Application.EnableEvents = False
'korrigiert ggf Fehler bei Groß-Kleinschreibung bei Eingabe
wksTNR.Cells(Target.Row, 17).Value = .Cells(rngZelle.Row, 1).Value
'Werte für GapsCode übertragen
wksTNR.Cells(Target.Row, 5).Value = .Cells(rngZelle.Row, 2).Text 'FY
wksTNR.Cells(Target.Row, 6).Value = .Cells(rngZelle.Row, 3).Text 'LY
wksTNR.Cells(Target.Row, 7).Value = .Cells(rngZelle.Row, 4).Value 'Book
wksTNR.Cells(Target.Row, 8).Value = .Cells(rngZelle.Row, 5).Value 'MS
wksTNR.Cells(Target.Row, 9).Value = .Cells(rngZelle.Row, 6).Text 'MB
Application.EnableEvents = True
End If
End With
End If
End Sub