'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'in der Tabelle (worksheet) mit Namen "sprungadr" wird das Sprungziel
'als String eingetragen. Immer wenn ein Wert in einer Zelle geändert
'wurde wird dann geprüft, in welche Zelle der Cursor danach springen soll.
'Format der Sprungadresse ist <arbeitsblattname>!<absolute Zelladresse>
'd.h. steht in sprungadr!A1 der String Tabelle1!$E$7, dann springt nach
'Eingabe/Änderung in JEDER Zelle A1 der Cursor immer in die Zelle E7 und zwar
'im Arbeitsblatt "Tabelle1"

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Excel.Range)
On Error GoTo unkorrekt
the_range = ""
the_range = Sheets("sprungadr").Range(Target.Address)
issheet = is_sheetname(the_range)
isrange = is_range(the_range)
If Not IsEmpty(issheet) And Not IsEmpty(isrange) Then
   Sheets(issheet).Select
   If Left(isrange, 1) <> "%" Then
      Range(isrange).Select
   Else 'relative Adresse
      test = Right(isrange, Len(isrange) - 1)
      komma = InStr(1, test, ",")
      r_offs = Left(test, komma - 1)
      c_offs = Right(test, Len(test) - komma)
      Range(Target.Address).Cells.Offset(r_offs, c_offs).Select
   End If
   Exit Sub
End If
If Not IsEmpty(isrange) Then
   If Left(isrange, 1) <> "%" Then
      Range(isrange).Select
   Else 'relative Adresse
      test = Right(isrange, Len(isrange) - 1)
      komma = InStr(1, test, ",")
      r_offs = Left(test, komma - 1)
      c_offs = Right(test, Len(test) - komma)
      Range(Target.Address).Cells.Offset(r_offs, c_offs).Select
   End If
End If
Exit Sub
unkorrekt:
End Sub


Private Function is_sheetname(ByVal s As String)
  is_sheetname = Empty
  test = InStr(1, s, "!")
  If test > 0 Then
     is_sheetname = Left(s, test - 1)
  End If
  
  test = is_sheetname
  
  ' man kann auch ohne den Tabellennamen RELATIV zum
  ' aktiven Tabellenindex springen
  ' Tabelle als relatives Sprungziel!
  ' [2] springe zu 2. Tabelle
  ' [+1] springe 1 Tabelle weiter nach hinten
  ' [-3] springe 3 Tabellen weiter nach vorn
  ' wenn NICHT möglich wird Sprung nicht ausgeführt
  ' z.Bsp: [+3]!$A$1 springt von der jetzigen Tabelle
  ' um 3 Blätter weiter nach hinten in Zelle A1
  
  If Left(test, 1) = "[" Then
     test = Mid(test, 2, Len(test) - 2)
     Select Case Left(test, 1)
       Case "+":
          offs = CInt(Right(test, Len(test) - 1))
       Case "-":
          offs = -1 * CInt(Right(test, Len(test) - 1))
       Case Else:
          test = CInt(test)
          is_sheetname = test
          Exit Function
     End Select
     is_sheetname = ActiveSheet.Index + offs
  End If
End Function

Private Function is_range(ByVal s As String)
  is_range = s
  test = InStr(1, s, "!")
  If test > 0 Then
     is_range = Right(s, Len(s) - test)
  End If
  
  test = is_range
  
  ' man kann auch ohne die absolute Adresse RELATIV zur
  ' aktiven Zelle springen
  ' Zelle als relatives Sprungziel!
  ' [2,3] springe mit Zelloffset (+2,+3) weiter
  ' [+1,-4] springe von z.B. E1 nach A2
  ' wenn NICHT möglich wird Sprung nicht ausgeführt
  
  If Left(test, 1) = "[" Then
     test = Mid(test, 2, Len(test) - 2)
     'die nächsten 4 Zeilen können durch eine Zeile ersetzt werden
     'komma = InStr(1, test, ",")
     'r_offs = Left(test, komma - 1)
     'c_offs = Right(test, Len(test) - komma)
     'is_range = "%" & r_offs & "," & c_offs
     'das Aufsplitten ist an dieser Stelle sinnlos, wäre nur
     'vertretbar, wenn gleichzeitig eine Plausibilitätsprüfung
     'der Eingabewerte durchgeführt würde ... folgendes reicht völlig
     is_range = "%" & test
  End If

End Function