zu meiner vorhergehenden Frage, eine erweiterungsfrage.
Ist es möglich, das gefundene Ergebnis aus einem sverweis als direkte Verknüpfung zum Fundort mit vba darzustellen? Wenn, wie?
Danke.
wossi
Private Sub Worksheet_Change(ByVal Target As Range)
If (Intersect(Target, Range("F10:P10")) Is Nothing) Or LCase(Target) "ist" Then Exit Sub
Application.EnableEvents = False
Target.Offset(6, 0).FormulaR1C1 = _
"=IF(R[-6]C=""IST"",VLOOKUP(R16C4,Tabelle2!C3:C7,R[-13]C[1],0),"""")"
If Target.Offset(6, 0) Then
MsgBox Sheets(2).Name & " " & Sheets(2).Range("C:C").Find(Range("D16")).Offset(0, Target. _
Offset(-7, 1) - 1).Address
End If
Application.EnableEvents = True
End Sub
Gruß
Tino
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Zeile As Long, strFormel As String, Zelle As Range, ws As Worksheet
Set ws = Worksheets("Tabelle2")
If Not Intersect(Target, Range("E10:P10")) Is Nothing _
And Target.Cells.Count = 1 Then
If LCase(Target.Value) = "ist" Then
If MsgBox("Sollen die Werte in Spalte " & Target.Column _
& " (" & Chr$(Target.Column + 64) & ") durch die Formel ersetzt werden?", _
vbQuestion + vbYesNo) = vbYes Then
'Wert durch Formel ersetzen für Zeilen mit Eintrag in Spalte 4 eintragen
For Zeile = Target.Row + 2 To Cells(Rows.Count, 4).End(xlUp).Row
If Not IsEmpty(Cells(Zeile, Target.Column)) Then
'Zelle mit dem Namen im Blatt 2 suchen
Set Zelle = ws.Columns.Find(What:=Me.Cells(Zeile, 4).Value, LookIn:=xlValues, _
lookat:=xlWhole)
If Not Zelle Is Nothing Then
strFormel = "='" & ws.Name & "'!R" & Zelle.Row & "C" & Zelle.Column + _
Target.Column - 4
Cells(Zeile, Target.Column).FormulaR1C1 = strFormel
Else
Cells(Zeile, Target.Column).Value = "kein Wert"
End If
End If
Next
End If
End If
End If
End Sub
vorausgesetzt die Tabelle hat die zugehörigen Werte in den Spalten neben dem Namen, dann ist _
mein vorheriges Makro wie folgt anzupassen.
?
hauptsache Suchkriterium und Ergebnis stehen in einer Zeile? Wieviele Spalten dazwischenliegen egal?
Private Sub Worksheet_Change(ByVal Target As Range)
'prüfe ob geänterte Zelle im Bereich F10:P10 ist und ob die geänderte Zelle = "ist" ist
If (Intersect(Target, Range("F10:P10")) Is Nothing) Or LCase(Target) "ist" Then Exit Sub
'events abschalten
Application.EnableEvents = False
'Formel eintargen von geänderte Zelle 6 Zellen nach unten
Target.Offset(6, 0).FormulaR1C1 = _
"=IF(R[-6]C=""IST"",VLOOKUP(R16C4,Tabelle2!C3:C7,R[-13]C[1],0),"""")"
'Prüfe ob Formel ein wahr ergebnis hat
If Target.Offset(6, 0) Then
'Suche Zelle für Namen (ist in etwa mit der SVERWEIS Formel gleich zu setzen)
MsgBox Sheets(2).Name & " " & Sheets(2).Range("C:C").Find(What:=Range("D16"), LookAt:=xlWhole). _
Offset(0, Target. _
Offset(-7, 1) - 1).Address
End If
Application.EnableEvents = True
End Sub
Gruß
Tino
Private Sub Worksheet_Change(ByVal Target As Range)
'prüfe ob geänterte Zelle im Bereich F10:P10 ist und ob die geänderte Zelle = "ist" ist
If (Intersect(Target, Range("F10:P10")) Is Nothing) Or LCase(Target) "ist" Then Exit Sub
'events abschalten
Application.EnableEvents = False
'Formel eintargen von geänderte Zelle 6 Zellen nach unten
Target.Offset(6, 0).FormulaR1C1 = _
"=IF(R[-6]C=""IST"",VLOOKUP(R16C4,Tabelle2!C3:C7,R[-13]C[1],0),"""")"
'Prüfe ob Formel ein wahr ergebnis hat
If Not IsError(Target.Offset(6, 0)) Then
'Suche Zelle für Namen (ist in etwa mit der SVERWEIS Formel gleich zu setzen)
MsgBox Sheets(2).Name & " " & Sheets(2).Range("C:C").Find(What:=Range("D16"), LookAt:=xlWhole). _
Offset(0, Target. _
Offset(-7, 1) - 1).Address
End If
Application.EnableEvents = True
End Sub
Gruß
Tino
Private Sub Worksheet_Change(ByVal Target As Range)
'prüfe ob geänterte Zelle im Bereich F10:P10 ist und ob die geänderte Zelle = "ist" ist
If ((Intersect(Target, Range("E10:E10")) Is Nothing) And LCase(Target) = "ist") Then
'events abschalten
Application.EnableEvents = False
'Formel eintargen von geänderte Zelle 6 Zellen nach unten
Target.Offset(6, 0).FormulaR1C1 = _
"=IF(R[-6]C=""IST"",VLOOKUP(R16C4,Tabelle2!C3:C7,R[-13]C[1],0),"""")"
'Prüfe ob Formel ein wahr ergebnis hat
If Not IsError(Target.Offset(6, 0)) Then
'Suche Zelle für Namen (ist in etwa mit der SVERWEIS Formel gleich zu setzen)
MsgBox Sheets(2).Name & " " & Sheets(2).Range("C:C").Find(What:=Range("D16"), LookAt:= _
xlWhole). _
Offset(0, Target. _
Offset(-7, 1) - 1).Address
End If
ElseIf ((Intersect(Target, Range("E16:E16")) Is Nothing) And LCase(Target.Offset(-6, 0)) = " _
ist") Then
'events abschalten
Application.EnableEvents = False
'Formel eintargen von geänderte Zelle 6 Zellen nach unten
Target.Offset(0, 0).FormulaR1C1 = _
"=IF(R[-6]C=""IST"",VLOOKUP(R16C4,Tabelle2!C3:C7,R[-13]C[1],0),"""")"
'Prüfe ob Formel ein wahr ergebnis hat
If Not IsError(Target.Offset(0, 0)) Then
'Suche Zelle für Namen (ist in etwa mit der SVERWEIS Formel gleich zu setzen)
MsgBox Sheets(2).Name & " " & Sheets(2).Range("C:C").Find(What:=Range("D16"), LookAt:= _
xlWhole). _
Offset(0, Target. _
Offset(-13, 1) - 1).Address
End If
End If
Application.EnableEvents = True
End Sub
Gruß
Tino
ElseIf ((Intersect(Target, Range("E16:E16")) Is Nothing) And LCase(Target.Offset(-6, 0)) = "ist") Then
Die Datei https://www.herber.de/bbs/user/50615.xls wurde aus Datenschutzgründen gelöscht