Anzeige
Archiv - Navigation
1172to1176
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro mit Loop zur Werteausgabe aus named ranges

Makro mit Loop zur Werteausgabe aus named ranges
Alexandra
Guten Tag,
ich möchte ein Makro erstellen, das durch alle Dateien in einem bestimmten Verzeichnis, und in diesen Dateien alle Blätter, durchloopt und dabei die Werte aus den gleichgenannten named ranges in jedem Blatt ausliest. Diese Werte soll es in einer Übersichtsdatei auf einem beliebigen Blatt in einer Spalte untereinander ausgeben.
Im Einzelnen soll es:
1) Im Verzeichnis /.../Input/ durch alle dort abgelegten Dateien durchloopen.
2) In jeder Datei durch alle Arbeitsblätter durchloopen und prüfen, ob das Arbeitsblatt eine named range namens "kombirange" enthält.
(Die named ranges sind alle auf Arbeitsblatt-Level und nicht auf Datei-Level definiert, damit sie überall die gleichen Namen haben können. Es sind fest definierte ranges und keine dynamic named ranges.)
Falls die Datei/das Arbeitsblatt keine named range "kombirange" enthält, soll es weitergehen. Falls es eine "kombirange" findet, dann soll es
3) Alle Werte aus dieser range nacheinander auslesen und in einer Übersichtsdatei (z.B. "Overview" genannt und im gleichen Verzeichnis wie der /.../Input/ - Ordner abgelegt) im Arbeitsblatt "Tabelle1" in der ersten Spalte nacheinander auflisten. (Als "kombirange" sind jeweils nur Bereiche, die eine Spalte breit und ca. 20-40 Zeilen lang sind, definiert.)
4) Fehler abfangen, wenn welche auftreten.
Ich habe schon zwar Codes im Internet gefunden, die es erlauben, Informationen aus gleichgebauten Dateien auszulesen und aufzulisten, aber leider keine Codes für den Zugriff auf named ranges. Leider kann ich auch keine Loops schreiben und hoffe wirklich auf Eure Hilfe.
Dieses Makro würde eine sehr große Arbeitserleichterung sein!
Vielen Dank im Voraus,
Alexandra

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro mit Loop zur Werteausgabe aus named ranges
06.09.2010 18:35:17
Oberschlumpf
Hi Alexandra
Deine "Wünsche" hören sich nach einem größeren Unterfangen an.
Daher wäre es vllt am besten, wenn du den möglichen Antwortern wenigstens eine (Bsp)-Datei zur Verfügung stellst, mit der sie dann versuchen können.
Denn außer dir weiß ja niemand hier, wie die Dateien aussehen.
Und wenn wirklich alle Dateien gleich aufgebaut sind, dann müsste eine Datei als Bsp eigentlich reichen.
Die Datei sollte auch ausreichend Bsp-Daten und vllt noch mal ne Beschreibung enthalten, was wann wie wo warum geschehen soll - und natürlich die Bereichsnamen nicht vergessen.
Ciao
Thorsten
Anzeige
Mal als Ansatz...
06.09.2010 19:58:39
Luc:-?
…für ein Teilproblem, Alexandra…
Dim Sh As Worksheet, ShN As Name
…
For Each Sh In ActiveWorkbook.Sheets
For Each ShN In Sh.Names
If ShN.Name = "…" Then
…
End If
Next ShN
Next Sh
…
Gruß Luc :-?
AW: Makro mit Loop zur Werteausgabe aus named ranges
07.09.2010 13:48:59
Alexandra
Hallo nochmal und vielen Dank erstmal für Eure Antworten,
ich füge noch nachträglich den Link zu einer Testdatei dazu:
https://www.herber.de/bbs/user/71416.xls
Die kombirange in jedem Blatt ist schwarz umrandet. Das Makro soll, wie gesagt, folgendes tun:
1) jede Datei im Verzeichnis /Input/ öffnen und dort in jedem Blatt nachschauen, ob eine lokal definierte named range ("kombirange") vorliegt.
2) Wenn "kombirange" vorhanden ist, dann soll er alle Werte aus dieser Kombirange (e.g. XXX-C001, XXX-C002, ...) auslesen und in ein neues File rüberkopieren. Dann weiter zum nächsten Blatt/File.
3) Wenn "kombirange" nicht vorhanden ist, weiter zum nächsten Blatt/File.
Gruss,
Alexandra
Anzeige
AW: Makro mit Loop zur Werteausgabe aus named ranges
07.09.2010 17:02:28
EvilRik
Hallo Alexandra,
versuch mal. Läuft unter 2007.

Option Explicit
Public strDateiPfad As String
Public strDateiFormat As String
Sub BeispielDatei()
On Error Resume Next
With Application.FileDialog(3)
.AllowMultiSelect = False
.InitialFileName = "C:\"
.InitialView = 1
.Title = "Wählen Sie eine Beispieldatei aus"
.Filters.Clear
.Filters.Add "Excel files", "*.xls", 1
.Filters.Add "Excel files", "*.xlsx", 2
.Filters.Add "All files", "*.*", 3
If .Show = -1 Then
strDateiFormat = Right(.SelectedItems(1), Len(.SelectedItems(1)) - InStrRev(. _
SelectedItems(1), ".", -1, vbTextCompare))
strDateiPfad = Mid(.SelectedItems(1), 1, InStrRev(.SelectedItems(1), "\", -1,  _
vbTextCompare) - 1)
End If
End With
End Sub
Sub StartSuche()
Dim fs, tmpOrdner, tmpDatei As Object, strName As String, tmpName, dd
Dim zae1 As Long
On Error Resume Next
Call BeispielDatei
Application.ScreenUpdating = False
If strDateiPfad = "" Then Exit Sub
Workbooks.Add
strName = "Kombirange" & Format(Date, "yymmdd") & "_" & Minute(Time) & ".xls"
ActiveWorkbook.SaveAs strDateiPfad & "\" & strName, xlNormal
Set fs = CreateObject("Scripting.filesystemobject")
Set tmpOrdner = fs.GetFolder(strDateiPfad)
For Each tmpDatei In tmpOrdner.Files
If Right(tmpDatei.Name, Len(strDateiFormat)) = strDateiFormat And tmpDatei.Name   _
strName Then
Workbooks.Open (tmpDatei.Name)
For Each tmpName In Workbooks(tmpDatei.Name).Names
zae1 = zae1 + 1
Workbooks(strName).Worksheets(1).Cells(1, zae1) = CStr(tmpName.Name)
Workbooks(strName).Worksheets(1).Cells(2, zae1) = tmpName
Workbooks(tmpDatei.Name).Worksheets(Mid(tmpName, 2, InStr(1, tmpName, "!") - 2)) _
. _
Range(Right(tmpName, Len(tmpName) - InStr(1, tmpName, "!"))).Copy
Workbooks(strName).Worksheets(1).Cells(3, zae1).PasteSpecial xlValues
Application.CutCopyMode = False
Next
If tmpDatei.Name  strName Then Workbooks(tmpDatei.Name).Close False
End If
Next
'Workbooks(strName).Close True
Application.ScreenUpdating = True
End Sub

Gruß Henrik
Anzeige
AW: Makro mit Loop zur Werteausgabe aus named ranges
08.09.2010 16:23:21
Alexandra
Hallo Henrik,
vielen Dank für deinen Code.
Leider hat er bei mir nicht funktioniert (ich habe Excel 2003, nicht 2007). Vielleicht kannst du mir ja sagen, was falsch gelaufen ist, wenn ich beschreibe, wie ich ihn getestet hatte.
Zum Testen habe ich den Ordner "Input" mit allen Dateien auf den Desktop rüberkopiert und in einem übergeordneten Ordner namens "test" verschoben. Dort habe ich eine Datei erstellt, sie "test" genannt und deinen Code in ein Modul reinkopiert, kompiliert und gespeichert. Dann habe ich das Makro "startsuche" laufen lassen.
Das Makro hat eine neue Datei namens "Kombirange100908" im "Input"-Ordner erstellt und hat dann der Reihe nach alle im Ordner "Input" befindlichen Dateien geöffnet, geprüft und geschlossen. Die Ergebnisse gab es in den ersten zwei Zeilen der "kombirange100908"-Datei aus.
Das Problem war, daß es nicht die Werte aus der named range "kombirange" aus jedem File herausgelesen hat, sondern daß es stattdessen alle named ranges aus allen Inputfiles und ihre zugehörigen Adressen herausgegeben hat.
z.B. A1 ="kombirange, A2 ="Input!A1:A3"
Ich möchte aber, daß das Makro folgendes macht: Wenn z.B. die Zellen A1-A3 als "kombirange" definiert ist, und in der Zelle A1 der Wert "R101" und in Zelle A2 "C103" steht, dann soll das Makro diese Werte auslesen und in der neuen Datei "kombirange100908" diese Werte nacheinander auflisten:
A1: =R101
A2: =C103
Es soll nur diese Daten aus der named range namens "kombirange" auslesen, und alle anderen named ranges nicht beachten. Meinst du, das geht?
Viele Grüsse,
Alexandra
Anzeige
AW: Makro mit Loop zur Werteausgabe aus named ranges
09.09.2010 11:59:29
EvilRik
Hallo Alexandra,
ersetze in dem Code entsprechenden Teil durch das:
...
For Each tmpName In Workbooks(tmpDatei.Name).Names
If tmpName.Name = "kombirange" Then
zae1 = zae1 + 1
With Workbooks(strName).Worksheets(1)
.Cells(1, zae1) = tmpDatei.Name
.Cells(2, zae1) = CStr(tmpName.Name)
.Cells(3, zae1) = tmpName
Workbooks(tmpDatei.Name).Worksheets(Mid(tmpName, 2, InStr(1, tmpName, "! _
") - 2)) _
.Range(Right(tmpName, Len(tmpName) - InStr(1, tmpName, "!"))).Copy
.Cells(4, zae1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Application.CutCopyMode = False
End If
Next
...

Gruß Henrik
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige