Pfadanpassung
Ernst
ich habe folgendes bestehende Makro das sehr gut funktioniert.
in meiner bestehenden Mappe wird (Zum Eingabewert zugeorneter Wert in Tabelle2 Spalte BTabellenblatt 2) abgefragt.
ich habe aus Tabellenblatt 2 eine eigene Mappe erstellt . "z:\test\Tabelle2"
könnte mir jemand mein bestehendes Makro an diesen Pfad anpassen .
wäre für Lösungsvorschläge dankbar.
lg.Ernst
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSpalte As Variant ' die Eingabe- und die zu vergleichenden Spalten
Dim iIndex As Integer ' Index für den Spalten-Array
Dim MyFind As Range ' zum Suchen in der Tabelle
Dim MyText As String ' fuer die MagBox
Dim sZugeordnet As String ' Einer Eingabespalte zugeordneter Wert
Dim iCount As Integer ' Anzahl Fundstellen in einer Eingabespalte
If Target.Count > 1 Then Exit Sub ' mehr als eine Zelle markiert ?
If Target.Value = "" Then Exit Sub ' ist die Zelle gefüllt ?
' B C I J P Q
iSpalte = Array(2, 3, 9, 10, 16, 17) ' die Spalten-Nummern als Array
If Target.Column = 2 Or Target.Column = 3 Or _
Target.Column = 9 Or Target.Column = 10 Or _
Target.Column = 16 Or Target.Column = 17 Then ' eine gültige Eingabe-Spalte ?
'Zum Eingabewert zugeorneter Wert in Tabelle2 Spalte B
With ThisWorkbook.Sheets("Tabelle2").Range("A1:A100").Cells
Set MyFind = .Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
End With
If MyFind Is Nothing Then
sZugeordnet = ""
MyText = ""
Else
sZugeordnet = MyFind.Offset(0, 1)
MyText = "Zugeordneter Wert: " & sZugeordnet
End If
For iIndex = 0 To UBound(iSpalte) ' alle Spalten abarbeiten/vergleichen
'Zählen des Eingabewertes in Spalte iIndex
iCount = Application.WorksheetFunction.CountIf(Columns(iSpalte(iIndex)), _
Target.Value)
If iCount > IIf(Target.Column = iSpalte(iIndex), 1, 0) Then
MyText = MyText & IIf(MyText = "", "", Chr(10)) _
& "Die Eingabe """ & Target.Value & """ gibt es " _
& "in der Spalte """ & Chr(Asc("@") + iSpalte(iIndex)) _
& """ und in Tabelle2 bereits." & Chr(10) & vbCrLf _
& "Wollen Sie den Eintrag trotzdem übernehmen?"
If MsgBox(MyText, 36, " nur zur Sicherheit.") = vbYes Then
MyText = "": Exit For
Else
Target.Value = "" ' die Eingabe löschen
Cells(Target.Row, Target.Column).Select ' Cursor auf die Eingabezelle
MyText = "": Exit For
End If
End If
Next iIndex
If MyText "" Then MsgBox MyText, vbInformation, _
Target.Value & " - Anzeige zugeordneter Wert"
End If
End Sub