Office: Feststellen, ob Zelle in benanntem Bereich?

Moin, moin!

Ich habe auf einem Sheet mehrere benannte Bereiche.
Wenn der User eine Zelle ändert möchte ich per VBA feststellen, ob diese Zelle in einem der benannten Bereiche liegt (genauer: in welchem sie liegt)

Geht das irgendwie?

Vielen Dank schon mal!

IngoXT

 

Hi Ingo,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("Bereich1")) Is Nothing Then
      MsgBox "Zelle im Bereich1"
   ElseIf Not Intersect(Target, Range("Bereich2")) Is Nothing Then
      MsgBox "Zelle im Bereich2"
   End If
End Sub

Bis später,
Karin

 

Intersect-Fehlermeldung

Hallo Karin,

vielen Dank erst Mal.

Auf intersect bin ich jetzt auch schon gestoßen und mir diese Funktion gebastelt:

Code:

Public Function NameZelle(rngTest As Range) As String
  
  Dim rngHelp As Range
  Dim rngIsect As Range
  Dim I As Integer
  
  With ActiveWorkbook
    For I = 1 To .Names.Count
      Set rngHelp = Range(.Names(I).Name)
      Set rngIsect = Application.Intersect(rngTest, rngHelp)
      If rngIsect Is Nothing Then
          NameZelle = ""
        Else
          NameZelle = rngHelp.Name
      End If
    Next I
  End With

End Function

Bekomme beim Testen beim Setzen von rngIsect aber immer die Meldung "die methode intersect für das objekt _global ist fehlgeschlagen".
Komme nicht dahinter, woran das liegt
rngTest und rngHelp sind jedenfalls richtig gesetzt.

IngoXT

 

Hi Ingo,

wie rufst du die Function auf? Ich habe es mal so getestet

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   NameZelle Target
End Sub

Ich kann deinen Fehler nicht nachvollziehen.

Bis später,
Karin

 

Test von NameZelle

Moin, moin!

Ich hatte mir da eine Testfunktion geschrieben:

Code:

Public Function TestNameZelle()
  Sheets("Tabelle1").Activate
  Debug.Print NameZelle(Range("Tabelle1!A2"))
End Function

Aber auch wenn ich NameZelle direkt aus dem Worksheet_Change-Ereignis heraus aufrufe, so wie Du, bekomme ich die gleiche Fehlermeldung.

Ich verwende übrigens Excel 2010, der Kunde hat aber noch Excel 2003, es ist also eine .xls-Datei.

lg

Ingo

 

NameZelle funktioniert in leerer Arbeitsmappe

Wenn ich die Funktion NameZelle in einem leeren Arbeitsblatt ausprobiere funktioniert sie.
Allerdings gibt sie nicht wie gewünscht den Namen des benannten Bereiches zurück, sondern seine Adresse, also so etwas wie:
=Tabelle1!$A$1:$D$8
Aber so klappt es:

Code:

Public Function NameZelle(rngTest As Range) As String
  
  Dim rngHelp As Range
  Dim rngIsect As Range
  Dim I As Integer
  
  With ActiveWorkbook
    For I = 1 To .Names.Count
      Set rngHelp = Range(.Names(I).Name)
      Set rngIsect = Application.Intersect(rngHelp, rngTest)
      If rngIsect Is Nothing Then
          NameZelle = ""
        Else
          NameZelle = .Names(I).Name
          Exit Function
      End If
    Next I
  End With

End Function

Leider immer noch nicht in dem Worksheet, in dem ich sie eigentlich brauche....
Gibt es für Excel auch so eine Reparaturmethode für korrupt Dateiene wie bei Access?

Ingo

 

andere Variante

Hi Ingo,
'hab noch eine von 'Jinx' gefunden in
http://www.ms-office-forum.net/forum/showthread.php?t=220916

Code:

Function fncGehörtZuNamen(Optional rngPrüf As Range) As String

Dim oName As Name
Dim rngZelle As Range

If rngPrüf Is Nothing Then
  fncGehörtZuNamen = "Fehler in zu überprüfendem Bereich - bitte prüfen!"
  Exit Function
End If

On Error Resume Next

For Each oName In ActiveWorkbook.Names
  Set rngZelle = Intersect(Range(oName.Name), rngPrüf)
  If Not rngZelle Is Nothing Then
    fncGehörtZuNamen = oName.Name
    Set rngZelle = Nothing
    Exit Function
  End If
Next oName

fncGehörtZuNamen = "keine Übereinstimmung mit benannten Bereichen"

End Function

Sub testaufruf()
MsgBox fncGehörtZuNamen(Range("Tabelle2!i7"))
End Sub

 

Die Lösung!

So, jetzt geht es.
Das Problem war, dass es die Names-Auflistung nur für das ganze Workbook gibt.
Es werden also auch benannte Bereiche gelistet, die nicht auf dem aktuellen Worksheet sind.
Intersect funktioniert aber nur, wenn die zu vergleichenden Ranges auf einem Worksheet sind.
Also muss man vor dem Aufruf von Intersect sicherstellen, dass es so ist.
Die Names-Auflistung enthält auch die Eigenschaft RefersTo, die so etwas
=Tabelle1!$A$1:$D$8
zurückgibt.
Daraus hole ich mir mit der folgenden Funktion den Tabellennamen:
?TabnameAusAdresse("=Tabelle1!$A$1:$D$8")
Tabelle1

Code:

Public Function TabnameAusAdresse(strAdr As String) As String
  
  Dim intPos As Integer
  
  intPos = InStr(strAdr, "!")
  If intPos = 0 Then Exit Function
  TabnameAusAdresse = Mid(strAdr, 2, intPos - 2)
  
End Function

Damit kann man dann auf gleiches Worksheet testen, und alles läuft:

Code:

Public Function NameZelle(rngTest As Range, Optional strSheet As String = "") As String
  
  Dim rngHelp As Range
  Dim rngIsect As Range
  Dim I As Integer
  Dim strTab As String
  
  With ActiveWorkbook
    If strSheet = "" Then
      strSheet = .ActiveSheet.Name
    End If
    For I = 1 To .Names.Count
      strTab = TabnameAusAdresse(.Names(I).RefersTo)
      If strTab = strSheet Then
        Set rngHelp = Range(.Names(I).Name)
        Set rngIsect = Application.Intersect(rngHelp, rngTest)
        If rngIsect Is Nothing Then
            NameZelle = ""
          Else
            NameZelle = .Names(I).Name
            Exit Function
        End If
      End If
    Next I
  End With

End Function

Man kann den Namen des gewünschten Sheets übergeben; tut man das nicht, dann wird das ActiveSheet genommen.

 

@Rudi4ad: Mit "On error resume next" geht es natürlich auch, aber dann werden alle anderen Fehler ja auch verschluckt.
Mache ich nicht so gerne.

Trotzdem vielen Dank!

Ingo