VBA: Benannte Bereiche ausfindig machen

Hallo Forum,

ich habe in einem Blatt mehrere Bereiche, die alle einen festen Namen haben, z.B. "Testbereich1", "Testbereich2", "Testbereich3",....

Diese Bereiche sind alle unterschiedlich groß, und die Größe (also Anzahl Zeilen/Spalten) ändern sich.

Die Abstände zwischen diesen Bereichen sind ebenfalls unterschiedlich groß und variieren auch. Es kann also nicht vorgegeben werden, in welcher Zeile ein Bereich beginnt.

Nun meine zwei VBA-Fragen: Ich möchte in all diesen Bereichen diesselbe Aktion durchführen.
- Wie kann ich die benannten Bereiche ausfindig machen und einlesen?
- Wie könnte die Schleife dafür aufgebaut werden?

Ich bitte Euch um Eure Hilfe.

Vielen Dank schon mal und Grüße
Franz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Franz

ich vermute mal Du kennst Dich inzwischen ein wenug aus. Darum aus meinem Archiv.

verwendete Namen finden
mit folgender Makrolösung kannst Du Dir alle verwendeten Namen in der Tabelle rausschreiben lassen.


Sub AlleNamenProtokollieren()
Dim benannteBereiche As Object
Sheets("Tabelle1").Activate
Range("A1").Select
For Each benannteBereiche In ActiveWorkbook.Names
ActiveCell.Value = benannteBereiche.Name
ActiveCell.Offset(0, 1).Value = ActiveWorkbook.Names.Item(benannteBereiche.Name)
ActiveCell.Offset(1, 0).Select
Next
End 

Sub
Möchtest Du alle Namen in der Tabelle markieren, verwendest Du folgende Syntax:

Sub AlleNamenMarkieren()
Dim VerName As Name
For Each VerName In ActiveWorkbook.Names
Range(VerName).Interior.ColorIndex = 3
Next VerName
End Sub





Sub Name_ermitteln()
Dim nm As Name
For Each nm In ActiveWorkbook.Names
If Not Application.Intersect(ActiveCell, Range(nm.RefersToRange.Address)) Is Nothing Then
MsgBox nm.Name
Exit Sub
End If
Next
MsgBox "Aktive Zelle gehört zu keinem mit Namen versehenen Bereich"
End Sub


Von Martin Beck




Sub Namen_Suchen()
'   erstellt von Hajo.Ziplies@web.de 27.04.03
Dim ObBereich As Object
Dim StName As String
StName = InputBox("Bitte gesuchten Namen eingeben!!")
For Each ObBereich In ActiveWorkbook.Names
If ObBereich.Name = StName Then
MsgBox "Name schon vorhanden"
Exit Sub
End If
Next
End Sub






Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.

Bitte kein Mail, Probleme sollen im Forum gelöst werden.



Microsoft MVP für Excel



Das Forum lebt auch von den Rückmeldungen.



Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.



Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.

Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.

Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.

Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.





http://home.media-n.de/ziplies/

Sub ZweiteZeileFaerben() Dim benannteBereiche As Object For Each benannteBereiche In ActiveWorkbook.Names Dim LetzteZeile Dim letztespalte Dim sp$, r%, s, i, e ActiveSheet.Unprotect r = Range(benannteBereiche).Row LetzteZeile = Selection.Row + Selection.Rows.Count - 1 letztespalte = 17 sp$ = Chr(letztespalte + 64) i = LetzteZeile e = ActiveSheet.UsedRange.Columns.Count Range(Cells(r, 1), Cells(i, e)).Interior.ColorIndex = _ xlColorIndexNone For s = r To LetzteZeile Step 2 Range("A" & s, sp & s).Select With Selection.Interior .ColorIndex = 19 .Pattern = xlSolid End With Next s Next End Sub

Sub ZweiteZeileFaerben() Dim benannteBereiche As Object For Each benannteBereiche In ActiveWorkbook.Names Dim LetzteZeile Dim letztespalte Dim sp$, r%, s, strName, i, e r = Range(benannteBereiche).Row Range(benannteBereiche).Select LetzteZeile = Selection.Row + Selection.Rows.Count - 1 letztespalte = 17 sp$ = Chr(letztespalte + 64) i = LetzteZeile e = ActiveSheet.UsedRange.Columns.Count Range(Cells(r, 1), Cells(i, e)).Interior.ColorIndex = _ xlColorIndexNone For s = r To LetzteZeile Step 2 Range("A" & s, sp & s).Select With Selection.Interior .ColorIndex = 19 .Pattern = xlSolid End With Next s Next Range("A9").Select End Sub

Sub ZweiteZeileFaerben() Dim benannteBereiche As Object Dim r&, s&, i&, e% Dim strName As Range Application.ScreenUpdating = False For Each benannteBereiche In ActiveWorkbook.Names Set strName = Range(benannteBereiche) r = strName.Row i = strName.Row + strName.Rows.Count - 1 e = strName.Column + strName.Columns.Count - 1 ' Alte Farben löschen: Range(Cells(r, 1), Cells(i, e)).Interior.ColorIndex = _ xlColorIndexNone ' Jede zweite Zeile färben: For s = r To i Step 2 Range(Cells(s, 1), Cells(s, e)).Interior.ColorIndex = 19 Next s Next Range("A9").Select End Sub

Sub AlleNamen_eine_Tabelle() ' erstellt von Hajo.Ziplies@web.de 15.09.03 ' http://home.media-n.de/ziplies/ ' Namen nur in einer Tabelle markieren Dim ObBenannteBereiche As Object Dim StName As String Worksheets("Tabelle1").Unprotect For Each ObBenannteBereiche In ActiveWorkbook.Names StName = ActiveWorkbook.Names.Item(ObBenannteBereiche.Name) If Mid(StName, 2, InStr(StName, "!") - 2) = "Tabelle1" Then ' Tabellennamen feststellen With Range(ObBenannteBereiche.Name).Interior .ColorIndex = 19 .Pattern = xlSolid End With End If Next Worksheets("Tabelle1").Protect End Sub

Beliebteste Forumthreads (12 Monate)

VBA: Benannte Bereiche ausfindig machen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

226 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA: Benannte Bereiche ausfindig machen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

226 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread