AW: Habe Schwierigkeiten diesen code anzupassen
30.05.2011 22:09:26
fcs
Hallo Stefan,
unter VBA ist das Arbeiten/Programmieren mit Cells(Zeile,Spalte) meist einfacher als mit der von den Tabellen her gewohnten A1-Schreibweise der Zelladressen.
Prizipiell kann man in VBA auch die Zell-Adresse in der A1-Schreibweise prüfen. Dabei muss die Zelladdresse als absoluter Bezug (mit $-Zeichen) angegeben werden. z.B.
Select Case Target.Address
Case "$A$2"
Case "$B$2"
End Select
Im Code müssen in deinem Fall bezogen auf die geänderte Zelle (Target) die Angaben zu Zeilen- und Spalten-Werte getauscht/angepasst werden. In der Hauptprüfung wird jetzt zuerst in der If-Prüfung auf die Zeile der geänderten Zelle geprüft. Danach dann auf die Spalten in den Case-Prüfungen.
Gruß
Franz
'Code im Modul der Tabelle in der Daten eingegeben werden
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks1 As Worksheet, Zelle As Range, vFind
Dim sAddresse As String
'Prüfen ob eine Zelle in Zeile 2 geändert wurde
If Target.Row = 2 And Target.Cells.Count = 1 Then
Set wks1 = Worksheets("Tabelle1") 'Name der Tabelle mit allen Namen
Select Case Target.Column
Case 1 'Nachname - in Spalte 1 (A)
vFind = Target.Value
If vFind = "" Then
'Eingabe wurde gelöscht
Target.Font.ColorIndex = xlColorIndexAutomatic
Else
'eingegebenen Namen in Spalte 1 (A) der Tabelle1 suchen
Set Zelle = wks1.Columns(1).Find(what:=vFind, LookIn:=xlValues, Lookat:=xlWhole)
If Zelle Is Nothing Then
'eingegebener Name in Tabelle1 nicht gefunden
Target.Font.ColorIndex = xlColorIndexAutomatic
Target.Offset(0, 1).Font.ColorIndex = xlColorIndexAutomatic
Else
If Zelle.Offset(1, 0) = "" Then
'Es ist noch kein Vorname eingegeben
Target.Font.ColorIndex = 3
Else
sAddresse = Zelle.Address
Target.Font.ColorIndex = xlColorIndexAutomatic
Target.Offset(0, 1).Font.ColorIndex = xlColorIndexAutomatic
'Prüfen, ob Kombination von Name und Vorname schon vorhanden
Do
If Target.Offset(0, 1).Value = Zelle.Offset(0, 1).Value Then
Target.Font.ColorIndex = 3
Target.Offset(0, 1).Font.ColorIndex = 3
Exit Do
End If
Set Zelle = wks1.Columns(1).FindNext(After:=Zelle)
Loop Until sAddresse = Zelle.Address
End If
End If
End If
Target.Offset(0, 1).Select
Case 2 'Vorname - in Spalte 2 (B)
vFind = Target.Value
If vFind = "" Then
'Eingabe wurde gelöscht
Target.Font.ColorIndex = xlColorIndexAutomatic
Else
'eingegebenen Vornamen in Spalte 2 (B) der Tabelle1 suchen
Set Zelle = wks1.Columns(2).Find(what:=vFind, LookIn:=xlValues, Lookat:=xlWhole)
If Zelle Is Nothing Then
'eingegebener Vorname in Tabelle1 nicht gefunden
Target.Font.ColorIndex = xlColorIndexAutomatic
Target.Offset(0, -1).Font.ColorIndex = xlColorIndexAutomatic
Else
If Zelle.Offset(0, -1) = "" Then
'Es ist noch kein Name eingegeben
Target.Font.ColorIndex = 3
Else
sAddresse = Zelle.Address
Target.Font.ColorIndex = xlColorIndexAutomatic
Target.Offset(0, -1).Font.ColorIndex = xlColorIndexAutomatic
'Prüfen, ob Kombination von Name und Vorname schon vorhanden
Do
If Target.Offset(0, -1).Value = Zelle.Offset(0, -1).Value Then
Target.Font.ColorIndex = 3
Target.Offset(0, -1).Font.ColorIndex = 3
Exit Do
End If
Set Zelle = wks1.Columns(2).FindNext(After:=Zelle)
Loop Until sAddresse = Zelle.Address
End If
End If
End If
Target.Offset(0, 1).Select
Case 3 To 4 ' Spalten C bis D, 4 (D) ist die letzte Spalte in Zeile 2 in der Eingabe _
automatisch _
in nächste Spalte springen soll
Target.Offset(0, 1).Select
End Select
End If
End Sub