Name des selektieren Bereichs löschen

Guten Abend
Mit untenstehendem Code kann ich den Bereichsnamen des selektierten Bereichs löschen.
Die auskommentierten Zeilen laufen nicht. Damit möchte ich folgendes erreichen.
Ein bestimmter Bereich oder eine Zelle, kann mehr als einen Bereichsnamen enthalten. Mit
Anz = Selection.Offset(0,0).Names.Count möchte ermitteln, wieviele Namen der selektierte Bereich (oder die Zelle) enthält. Falls das Ergebnis null ist, gibt es nichts zu löschen, anderenfalls soll Select Case entsprechend der Anzahl Namen durchlaufen werden.
Zudem liefert mir die MsgBox nur den Bereichs- oder Zellbezug. Ich möchte jedoch in der MsgBox den Namen, der dann gelöscht wird aus Ausgabe erhalten.
Wer kann mir helfen?
Danke und Gruss, Peter

Sub NamenWeg()
Dim Anz As Long, i As Long
'''Anz = Selection.Offset(0, 0).Names.Count
'''if Anz = 0 then GoTo Ende
'''    For i = 1 To Anz
Select Case MsgBox(Selection.Offset(0, 0).Name, vbInformation + vbYesNo)
Case vbYes: Selection.Offset(0, 0).Name.Delete
Case vbNo: GoTo WeiterBeiNein
End Select
WeiterBeiNein:
'''    Next i
Ende:
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub NamenWegVariante1() Dim N_M As Name, Anzahl As Long, i As Long Anzahl = 0 For Each N_M In Names If N_M.Name = "=" & Selection.Parent.Name & "!" & Selection.Address Then Anzahl = Anzahl + _ 1 Next If Anzahl = 0 Then GoTo Ende For i = 1 To Anzahl Select Case MsgBox(Selection.Offset(0, 0).Name, vbInformation + vbYesNo) Case vbYes: Selection.Offset(0, 0).Name.Delete Case vbNo: GoTo Weiter End Select Weiter: Next i Ende: End Sub

Sub NamenWeg() Dim N_M As Name, Anzahl As Long, i As Long Anzahl = 0 On Error Resume Next For Each N_M In ActiveWorkbook.Names If IsError(N_M) Then GoTo Weiter If N_M.RefersToRange.Address = Selection.Address Then Anzahl = Anzahl + 1 Next If Anzahl = 0 Then GoTo Ende For i = 1 To Anzahl Select Case MsgBox(Selection.Offset(0, 0).Name, vbInformation + vbYesNo) Case vbYes: Selection.Offset(0, 0).Name.Delete Case vbNo: GoTo Weiter End Select Weiter: Next i Ende: End Sub

Sub namenLoeschen() Dim objName As Name Dim rng As Range For Each objName In ThisWorkbook.Names On Error Resume Next Set rng = objName.RefersToRange On Error GoTo 0 If Not rng Is Nothing Then If Not Intersect(rng, Selection) Is Nothing Then If MsgBox("Den Namen '" & objName.Name & "' löschen", _ vbQuestion + vbYesNo, "Frage") = vbYes Then objName.Delete End If End If Set rng = Nothing Next End Sub

Sub namenLoeschen() Dim objName As Name Dim rng As Range For Each objName In ThisWorkbook.Names On Error Resume Next Set rng = objName.RefersToRange On Error GoTo 0 If Not rng Is Nothing Then If Not Intersect(rng, Selection) Is Nothing Then If rng.Address = Selection.Address Then If MsgBox("Den Namen '" & objName.Name & "' löschen", _ vbQuestion + vbYesNo, "Frage") = vbYes Then objName.Delete End If End If End If Set rng = Nothing Next End Sub

Hallo Sepp
In einem "einfachen" Testfile hat das funktioniert. Super. Vielen Dank.
Jetzt bin ich auf folgendes Problem gestossen: In einem grösseren File
kommt die Fehlermeldung "Die Methode Intersect für das Objekt _Global ist fehlgeschlagen (Laufzeitfehler 1004).
Ich habe auf debug gedrückt und dann die aktuellen Variablen im Direktbereich abgefragt:
?objname
=Externe!$F$45:$F$60
?objname.Name
Externe!_FilterDatabase
objname.Name
?rng.Name
=Externe!$F$45:$F$60
?rng.Parent.name
Externe
?selection.name
=Cockpit!$C$31
Hier stört anscheinend der Name "_FilterDatabase". Komisch darin ist, dass dieser gar nicht existiert. Weder in der Tabelle "Externe", noch sonst wo in der Datei.
Wenn ich On Error GoTo 0
auskommentiere, lauft der Code durch. Das ist vielleicht die einfachste Lösung, doch es wurmt mich schon, weshalb ein Name, der gar nicht zu existieren scheint (auch nicht im Namensmanager), solche Probleme verursacht.
Gruss, Peter

Sub namenLoeschen() Dim objName As Name Dim rng As Range For Each objName In ThisWorkbook.Names On Error Resume Next Set rng = objName.RefersToRange On Error GoTo 0 If Not rng Is Nothing Then If rng.Parent.Name = Selection.Parent.Name Then If Not Intersect(rng, Selection) Is Nothing Then If rng.Address = Selection.Address Then If MsgBox("Den Namen '" & objName.Name & "' löschen", _ vbQuestion + vbYesNo, "Frage") = vbYes Then objName.Delete End If End If End If End If Set rng = Nothing Next End Sub

Beliebteste Forumthreads (12 Monate)

Name des selektieren Bereichs löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread