Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1440to1444
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1440to1444
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ergebnisse mit Schleife darstellen/auflisten

Ergebnisse mit Schleife darstellen/auflisten
13.08.2015 19:51:39
Vaidotas
Hallo,
hoffentlich kann mir jemand helfen. Folgendes:
in einem bestimmten Folder:
Dim strDir As String
strDir = Sheets("Mapping").Range("strDir")
Dim strFile As String
strFile = Dir(strDir & "*.xls*")
sind mehrere Excel dateien.
Nun versuche ich in:
ThisWorkbook.Activate
Dim rgBase As Range
Set rgBase = Sheets("Recon").Range("A1")
Die Ergebnisse darzustellen/auflisten:
zunächst habe ich schon problem richtig erste schleife zu machen, denn ich möchte Dateiname in die erste Spalte A haben. Es soll sich so oft wiederholen wieviel verschiede Beiträge in der Spalte B kommen werden.
Beispiel:
Spalte A, Spalte B
1111, 1
1111, 2
1111, 3
1112, 1
1112, 2
1113, 1
1113, 2
usw...
Gruss
Vaidotas

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ergebnisse mit Schleife darstellen/auflisten
14.08.2015 00:44:06
fcs
Hallo Vaidotas,
das Grundgerüst für die Auswertung der Dateien in einem Verzeichnis kann wie folgt aussehen.
Den auswertenden Teil, der die Daten der Quelltabellen in die Zeilen einträgt musst du anpassen.
Gruß
Franz 
Sub prcGetData()
Dim strDir As String
Dim strFile As String
Dim wkbBase As Workbook, rgBase As Range, lngOffset As Long
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, Zeile_Q As Long
Dim StatusCalc As Long
'Zieldatei setzen
Set wkbBase = ThisWorkbook
'Auszuwertendes Verzeichnis einlesen
strDir = wkbBase.Sheets("Mapping").Range("strDir")
With Application
strDir = strDir & IIf(Right(strDir, 1) = .PathSeparator, "", .PathSeparator)
End With
strFile = Dir(strDir & "*.xls*")
wkbBase.Activate
'Startzelle für das Eintragen der Daten setzen
Set rgBase = wkbBase.Sheets("Recon").Range("A1")
'gefundene Dateien abarbeiten
If strFile = "" Then
MsgBox "keine Excel-Datei im Verzeichnis" & vbLf & vbLf _
& strDir, _
vbOKOnly, "Dateien auswerten"
Else
'Makrobremsen lösen
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
lngOffset = -1
Do Until strFile = ""
'Datei schreibgeschützt öffnen
Set wkbQuelle = Application.Workbooks.Open(Filename:=strDir & strFile, _
ReadOnly:=True)
'Tabelle mit Daten setzen
Set wksQuelle = wkbQuelle.Worksheets(1)
'Daten auswerten
With wksQuelle
For Zeile_Q = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile_Q, 1).Text  "" Then
lngOffset = lngOffset + 1
rgBase.Offset(lngOffset, 0).Value = strFile
rgBase.Offset(lngOffset, 1).Value = .Cells(Zeile_Q, 1).Value
End If
Next
End With
wkbQuelle.Close savechanges:=False
'nächste Datei auslesen
strFile = Dir
Loop
'Makrobremsen zurücksetzen
With Application
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige