Microsoft Excel

Herbers Excel/VBA-Archiv

Löschen von lokalen Bereichsnamen | Herbers Excel-Forum


Betrifft: Löschen von lokalen Bereichsnamen von: Peter
Geschrieben am: 23.12.2009 20:29:23

Guten Abend

Ich habe in einer Arbeitsmappe eine Unmenge Bereichsdefinitionen. Jedes Mal, wenn ich eine Tabelle innerhalb dieser Arbeitsmappe dupliziere, werden gewisse Bereichsnamen nochmals lokal angelegt, was in der Grafik nachfolgend an dem rechts erscheinenden '9513' (Name eines Worksheets) ersichtlich ist.

Gibt es eine Möglichkeit, alle nur lokal gültigen Bereichsnamen innerhalb einer Arbeitsmappe mit einem Makro zu löschen? Wenn ja, kann mir jemand den dafür nötigen Code zur Verfügung stellen?

Danke, Peter


  

Betrifft: schau Dir mal diesen Beitrag an... von: Tino
Geschrieben am: 23.12.2009 20:36:25

Hallo,
, könnte doch passen.

https://www.herber.de/forum/archiv/1120to1124/t1121941.htm

Gruß Tino


  

Betrifft: AW: schau Dir mal diesen Beitrag an... von: Peter
Geschrieben am: 23.12.2009 21:06:08

Hallo Tino
Das hat zumindest ähnlich getönt, doch anhand des hochgeladenen Beispieldatei ist ersichtlich, dass dann falsche Namen gelöscht werden:
in der 1. Tabelle habe ich eine Zelle mit "abc" definiert
dann habe ich die 1. Tabelle dupliziert
in beiden ist nun "abc" enthalten
gelöscht soll allerdings nur das "abc" in der 2. Tabelle werden.
mit dem im Link auffindbaren Makro werden hier aber beide Namen gelöscht.

kann man Namen mit "dem Eintrag rechts" - hier also '9513' irgendwie abfangen?

Danke für jeden Hinweis, Peter

https://www.herber.de/bbs/user/66809.xls


  

Betrifft: versuche es mal hiermit von: Tino
Geschrieben am: 23.12.2009 21:54:20

Hallo,
ok. verstehe was Du meinst, hoffe ich.

Teste mal diesen Code.

Sub alle_Namen_löschen()
Dim oName As Name, rngVerweis As Range
Dim meArNamen(), i As Integer, strName$
'sollte der Name eine Formel sein 
On Error Resume Next
    
    'Schleife über alle Namen und Namen der aktiven Tabelle Sammeln 
    For Each oName In ActiveWorkbook.Names
        'Namen versuchen einem Rangeobjekt zuzuweisen 
        Set rngVerweis = Range(oName.Name)
        'ist Rangeobjekt ein Zellbereich? 
        If Not rngVerweis Is Nothing Then
            'Befindet sich dieses Rangeobjekt auf der aktuellen Tabelle? 
            If Not oName.Name Like "*!*" Then
              'enferne Hochkomme 
              strName$ = Replace(oName.Name, "'", "")
              'entferne Tabellenname 
              strName$ = Replace(strName$, rngVerweis.Parent.Name & "!", "")
              If i > 0 Then
                    If Not IsNumeric(Application.Match(strName$, meArNamen, 0)) Then
                     Redim Preserve meArNamen(i)
                     meArNamen(i) = strName$
                     i = i + 1
                    End If
              Else
                    Redim Preserve meArNamen(i)
                    meArNamen(i) = strName$
                    i = i + 1
              End If
            End If
        End If
    Next oName
    
    If i > 0 Then
    'Schleife über alle Namen 
    For Each oName In ActiveWorkbook.Names
        'Namen versuchen einem Rangeobjekt zuzuweisen 
        Set rngVerweis = Range(oName.Name)
        'ist Rangeobjekt ein Zellbereich? 
        If Not rngVerweis Is Nothing Then
        'ist im Namen ein ! 
            If oName.Name Like "*!*" Then
              'enferne Hochkomme 
              strName$ = Replace(oName.Name, "'", "")
              'entferne Tabellenname 
              strName$ = Replace(strName$, rngVerweis.Parent.Name & "!", "")
              'ist der Name bereits vergeben, Namen löschen 
              If IsNumeric(Application.Match(strName$, meArNamen, 0)) Then
                oName.Delete
              End If
            End If
        End If
    Next oName
    End If
'On Error GoTo 0  ' nur nötig wenn Makro hier weiter laufen sollte 
End Sub
Gruß Tino


  

Betrifft: AW: versuche es mal hiermit von: Peter
Geschrieben am: 23.12.2009 22:09:48

Hallo Tino
Vielen Dank für deinen Code - in meiner einfachen Datei funktioniert das. In der Datei, in der es zur Anwendung kommen sollte leider nicht.
Vielleicht, weil "bezieht sich" auf ein bischen speziell ist, nämlich beispielsweise:
=BEREICH.VERSCHIEBEN('11'!$H$1;ANF-1;;END-ANF+1;)
ANF habe ich den Wert 1, END den Wert 1300 zugewiesen.
Diese Art Bezug habe ich gewählt, weil ich ab und die Anzahl Zeilen sämtlicher Spaltenbereiche anpassen muss.
Vielleicht kannst du diese Art Bezug mit einem kleinen Eingriff im Code abfangen - das wäre natürlich super. Nochmals Besten Dank.
Gruss, Peter


  

Betrifft: versuchen wir es so von: Tino
Geschrieben am: 23.12.2009 22:35:32

Hallo,

Sub alle_Namen_löschen()
Dim oName As Name, rngVerweis As Range
Dim meArNamen(), i As Integer, strName$
'sollte der Name eine Formel sein 
On Error Resume Next
    
    'Schleife über alle Namen und Namen der aktiven Tabelle Sammeln 
    For Each oName In ActiveWorkbook.Names
        'Namen versuchen einem Rangeobjekt zuzuweisen 
        Set rngVerweis = Range(oName.Name)
        'ist Rangeobjekt ein Zellbereich? 
        If Not rngVerweis Is Nothing Then
            'Befindet sich dieses Rangeobjekt auf der aktuellen Tabelle? 
            If Not oName.Name Like "*!*" Then
              'enferne Hochkomme 
              strName$ = Replace(oName.Name, "'", "")
              'entferne Tabellenname 
              strName$ = Replace(strName$, rngVerweis.Parent.Name & "!", "")
              If i > 0 Then
                    If Not IsNumeric(Application.Match(strName$, meArNamen, 0)) Then
                     Redim Preserve meArNamen(i)
                     meArNamen(i) = strName$
                     i = i + 1
                    End If
              Else
                    Redim Preserve meArNamen(i)
                    meArNamen(i) = strName$
                    i = i + 1
              End If
            End If
        End If
    Next oName
    
    If i > 0 Then
        'Schleife über alle Namen 
        For Each oName In ActiveWorkbook.Names
                If oName.Name Like "*!*" Then
                  For i = Lbound(meArNamen) To Ubound(meArNamen)
                     If oName.Name Like "*!" & meArNamen(i) Then
                        oName.Delete
                        Exit For
                     End If
                  Next i
                End If
        Next oName
    End If
'On Error GoTo 0  ' nur nötig wenn Makro hier weiter laufen sollte 
End Sub
Gruß Tino


  

Betrifft: AW: versuchen wir es so von: Peter
Geschrieben am: 23.12.2009 23:53:14

Hallo Tino
Dieser Versuch war erfolgreich.
Super, Danke
Peter


Beiträge aus den Excel-Beispielen zum Thema "Löschen von lokalen Bereichsnamen"