Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1564to1568
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

Test

Test
28.06.2017 10:23:28
Saerdna
Hallo zusammen,
nach zwischenzeitlich gefühlten 100Jahren des mitlesen und durch die vielen erstklassigen Infos aus diesem Forum, welche ich auch erfolgreich in meine Excel-Dateien "Einbauen" konnte, benötige ich nun erstmalig Eure aktive Unterstützung (Infos/Ideen) zu meinem neuen Vorhaben.
Ausgangssituation:
Habe vor rund 8 Jahren eine recht umfangreiche Excel-Datei zur Erfassung von Arbeitszeiten, Einsatzarten etc. pp. erstellt, welche bei uns in der Familie und im Freundeskreis in mehreren kleinen Handwerksbetrieben (kostenlos, da ich keine kommerzielles Interesse habe) durchgängig genutzt wird.
Zu jedem Mitarbeiter wird eine Datei angelegt und alle Infos zu den Zeiten und seinen Tätigkeiten verwaltet. Vieles ist durchgängig in der Datei automatisiert, Fehlerroutinen sind eingebaut usw. und so weiter. Soviel zur Einleitung. :-)
Mein Vorhaben/Idee
Möchte nun eine neue Datei erstellen (sozusagen eine "Masterdatei") in der alle Einzelergebnisse aus den jeweiligen Mitarbeiter-Exceldateien dargestellt werden können. Aktuell mache ich/wir dies noch händisch in dem die jeweilige Datei geöffnet, der gewünschte Wert abgelesen und in einer weiteren Datei abgelegt wird.
Künftig möchte ich dies über einen VBA-Code automatisieren.
Grundsätzlich stelle ich mir dies recht einfach vor. ;-)
Alle Dateien sind vom Aufbau gleich und die auszulesenden Informationen stehen auch IMMER an der jeweils gleichen Position (Arbeitsblatt, Zelle, Spalte) in der auszulesenden Datei. Alle Dateien "liegen" auch immer in dem Ordner in dem die neue Masterdatei abgelegt ist/werden soll. Einziger Unterschied ist der Name des Mitarbeiters. Eine Datei heißt z.B. Klaus Muster.xlsm, die nächste Dieter Muster.xlsm die nächste Armin Muster.xlsm usw.
Im Grunde genommen bräuchte ich einen Code/Codebaustein (den ich individuell anpassen kann).
Übersetzt stelle ich mir dies so vor:
Prüfe ob eine andere Datei außer der Masterdatei im aktuellen Ordner liegt.
Wenn ja, lese aus dieser Datei (zum Beispiel) aus dem Arbeitsblatt "Allgemeines" die Zellen E5, E7, E9, G29, G30 und G31 aus und schreibe den jeweiligen Wert in die Zelle B2, B3, B4, B5, B6 in das Arbeitsblatt "Ergebnisse Seite 1" in dieser Datei.
Wenn fertig prüfe ob eine weitere, noch nicht ausgelesene Datei in diesem Ordner liegt und wiederhole den Vorgang bis alle Dateien abgearbeitet sind.
Bin Euch auch für Einzelcode (bitte mit kleinem Kommentar) für die jeweilige "Teil-Aufgabe" dankbar.
So ich hoffe, dass ich nicht zu viel geschrieben habe und trotzdem jemand von Euch noch Lust hat mich zu unterstützen. Meine VBA-Kenntnisse sind nicht schlecht aber auch nicht wirklich erstklassig. ;-)
Viele Grüße
Andreas
P.S: Habe die letzten Tage natürlich schon einiges ausprobiert, komme aber nicht wirklich weiter damit.

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Test
28.06.2017 10:44:01
yummi
Hallo Saerdna,
alle Dateien finden und importieren kannst Du so:

strPath = C:ßVerzeichnis\"
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strExt = "*.xlsm"
strfile = Dir(strPath & strExt)
Do While Len(strfile) > 0
'öffne Datei
Set wkbSource = Workbooks.Open(Filename:=strfile, ReadOnly:=True, UpdateLinks:=False)
'Daten übertragen
'wksDest kannst du ja vorher als Thisworkbook.Sheets("Wohindiedatensollen") anlegen
wksDest.Cells(2,2).value = wkbSource.Sheets("Allgemeines").Cells(5,5).value
'usw für alle Daten
wkbSource.close false    'Importdatei schliessen
strfile = Dir() 'nächste Datei
Loop
Ich hoffe es hilft dir weiter
Gruß
yummi
Anzeige
AW: Test
28.06.2017 11:30:11
Saerdna
Hallo zusammen,
das ging ja flott. :-)
Habe mir den Link von Case mal angeschaut. So etwas ähnliches hatte ich schon im Netz gefunden, bin aber mit der Anpassung nicht klar gekommen. Dies sieht jedoch deutlicher besser/klarer aus. Danke, werde mich mal in Ruhe damit auseinandersetzen. Kommt meinen Gedanken so vom ersten durchlesen und verstehen aber schon sehr nah.
Auch Dir yummi vielen Dank für den Code, hilft mir auf jeden Fall weiter meine Projekt besser in den Teilbereichen zu verstehen und auszubauen. :-)
Viele Grüße
Andreas
P.S: Kann man meinen Threadtitel irgendwo nochmals ändern? Habe bei der Bezeichnung wohl etwas Mist gebaut. ;-)
Anzeige
AW: Test
29.06.2017 10:27:15
Saerdna
Hallo Case,
Der Programmcode (Sowohl mit Array als auch ohne Array) ist wirklich klasse. :-) Konnte ihn auch soweit meinen Anforderungen (Bereich) anpassen und läuft auch einwandfrei. Danke für den Link. :-)
Aber.... der Code durchläuft ja die angegeben Zellen in den Spalten. Leider schaffe ich es nicht dem Code mitzuteilen, dass er in der "Suchdatei", "Sucharbeitsblatt" NUR in der Spalte B den Bereich von B1 bis B21 durchlaufen soll und die Werte dann in die erste leere Spalte des definierten Arbeitsblattes in der Zieldatei, beginnenden mit der Spalte B Zelle 1 (also B1), einlesen soll.
Hintergrund ist die Darstellung. Bei der vorliegenden Auswertung (nach meiner Codeanpassung) habe ich die Werte nun in den Zellen
A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2,L2,M2,N2,O2,P,Q2,R2,S2,T2,U2 also A2:U2 stehen.
Besser für meine weitere Verarbeitung wäre es die Daten in den Zellen B1, B2, B3....bis B21 stehen zu haben und weiter dann natürlich mit den Spalten C, D, E, F, G, H usw.
Kannst Du mir hier kurz mitteilen in welchem Bereich ich dies ändern muss? Habe es versucht, komme aber leider nicht hinter die Logik bzw. den Aufbau Deines Programmcodes für diese spezielle Änderung.
Viele Grüße
Andreas
Anzeige
Du brauchst doch eigentlich...
30.06.2017 08:02:44
Case
Halo Andreas, :-)
... nur statt der letzten Zeile, die letzte Spalte ermitteln und die Codezeile wo die Formel eingetragen wird anpassen. Bekommst Du das hin, oder brauchst Du eine Beispieldatei? ;-)
Servus
Case

AW: Du brauchst doch eigentlich...
30.06.2017 16:54:42
Saerdna
Hallo Case :-)
habe es gerade versucht und im letzten Abschnitt des Codes danach gesucht, zu meinem Leidwesen aber nicht gefunden. Fürchte, ich brauche hier doch ein mehr an tatkräftiger Unterstützung
Anbei mal der angepasste Code:

Public Sub dirInfo(ByVal objCurrentDir As Object, ByVal strName As String, _
Optional ByVal blnTMP As Boolean = False)
' Variablendeklaration
Dim strFormula As String
Dim lngLastRow As Long
Dim arrCell As Variant
Dim intTMP As Integer
Dim varTMP As Variant
' Weitere Zellen nach gleichem Muster in das Array einfügen
arrCell = Array("A2", "B2", "C2", "D2", "E2", "F2", "G2")
' Alle Dateien im vorgegebenen Ordner
For Each varTMP In objCurrentDir.Files
' Dateiname entspricht den Vorgaben und ist nicht DIESE Datei
' Falls im gleichen Ordner und ist KEINE temporäre Datei
If varTMP.Name Like strName And varTMP.Name  _
ThisWorkbook.Name And Left(varTMP.Name, 1)  "~" Then
' Der Code bezieht sich auf ein bestimmtes Objekt
' Hier strSheetZ
' Alles was sich auf dieses "With" bezieht MUSS mit einem Punkt beginnen
With ThisWorkbook.Worksheets(strSheetZ)
' Letzte Zeile bezogen auf Spalte A plus 1
lngLastRow = IIf(Len(.Cells(.Rows.Count, 1)), _
.Rows.Count, .Cells(.Rows.Count, 1).End(xlUp).Row) + 1
' Schleife über alle Zellen des Arrays
For intTMP = LBound(arrCell) To UBound(arrCell)
' Hier kann noch der Dateiname mit komplettem Pfad in die nächste freie  _
Spalte geschrieben werden
'.Cells(lngLastRow, UBound(arrCell) + 2).Value = varTMP.Path
' Hier kann noch der Dateiname incl. Erweiterung in die nächste freie  _
Spalte geschrieben werden
.Cells(lngLastRow, UBound(arrCell) + 2).Value = varTMP.Name
' Werte über Formel holen, Tabellenblatt über "Const..." oben definiert,  _
Zelle über Array. Formel in Spalte A folgende...
.Cells(lngLastRow, intTMP + 1).Formula = "='" & Mid(varTMP.Path, 1, _
InStrRev(varTMP.Path, "\")) & "[" & _
Mid(varTMP.Path, InStrRev(varTMP.Path, _
"\") + 1) & "]" & strSheetQ & "'!" & arrCell(intTMP)
Next intTMP
End With
End If
Next varTMP
' Wenn die Variable blnTMP "True" ist (in der Sub "Files_Read_1" vorgegeben dann durchsuche  _
auch alle Unterordner
If blnTMP = True Then
For Each varTMP In objCurrentDir.SubFolders
dirInfo varTMP, strName, blnTMP
Next varTMP
End If
End Sub
Wie erkennbar ist, "lese" ich aktuell nur den Bereich A2 bis G2, also alles auf der zweiten Zeile von A bis G.
Die zu lesenden Daten stehen für diese "Abfrage" nun aber in dem Bereich A2 bis G100.
Nun würde ich natürlich gerne jede Zeile in diesem Bereich durchlaufen wollen und sofern ein Wert in der Zeile noch vorhanden ist (es gibt keine Leerzellen) solange die entsprechende Zeile von A bis G in das Arbeitsblatt der abrufenden Datei einlesen wollen.
Kannst Du (aber gerne auch jemand anderes :-)) mit hier behilflich sein?
Viele Grüße
Andreas
Anzeige
AW: Du brauchst doch eigentlich...
01.07.2017 15:35:25
Saerdna
Sorry, wenn ich den Thread selbst hoch hole, aber ich komme einfach mit dem Thema nicht weiter. :-(
Meine einzelnen Dateien für die jeweiligen Mitarbeiter habe ich jetzt soweit angepasst, dass in jeder dieser Dateien ein ausgeblendetes Arbeitsblatt (Baustellenliste) mit, aus den anderen Arbeitsblättern in der gleichen Datei ausgelesenen Werten in dem Zellbereich A1 bis G100 vorhanden ist. Diesen Bereich habe ich so bearbeitet, dass keine leeren ZEILEN zwischen dem ersten und letzten Eintrag vorhanden sind. Diesen gesamtem Zellbereich möchte ich gerne "durchlaufen" und solange ein Wert in der jeweiligen Zelle in der Spalte A vorhanden ist, die gesamte Zeile, also von A bis G (auch wenn in der Spalte B, C, D, E, F oder G KEIN Wert vorhanden ist!) kopieren und in die auslesende Datei übertragen. Ausschlaggebend zum auslesen ist NUR ob in der Spalte A ein beliebiger Wert steht.
Übersetzt stelle ich mir die wie folgt vor:
Grundlage die Datei von Case.
In diesen Code eine Schleife einbauen die die jeweiligen Zeilen des auszulesenden Arbeitsblattes "Baustellenliste" solange durchlaufen bis alle ZEILEN (A bis G) mit einem Wert in der Spalte A ausgelesen wurden. Diese sollen dann in die auslesende Datei im gleichen Aufbau ab Zeile 3 in der Spalte A eingelesen werden.
Der Code von Case ist ja wirklich klasse, aber er (der Code ;-)) überfordert leider meine VBA-Fähigkeiten zum anpassen des Codes. Sorry dafür :-)
Viele Grüße (vom zwischenzeitlich ausgelaugten)
Andreas
Anzeige
Das Ergebnis in...
02.07.2017 10:21:00
Case
Hallo Andreas, :-)
... Spalten geht so: ;-)
Werte nicht in Zeilen, sondern in Spalten...
Kommst Du nicht klar? Sende mal gezippt die Ergebnisdatei plus zwei Quelldateien. Genaue Beschreibung was wohin soll. Habe im Moment wenig Zeit, aber schaue mal... ;-)
Servus
Case

AW: Das Ergebnis in...
04.07.2017 07:48:12
Saerdna
Hallo Case :-)
lieben Dank für Dein Unterstützung und ja, ich komme zwischenzeitlich wieder klar. :-) Habe die letzten Jahre mit VBA nichts mehr groß gemacht da meine Dateien funktioniert haben und somit rostet man halt dann doch etwas ein.
So, nach unzähligen Kaffee`s und Cigaretten habe ich mir nun eine Lösung gebastelt, die zumindest mal funktioniert. Habe Deinen ursprünglichen Code soweit angepasst, dass ich über ein For alle Zeilen in den vorgegebenen Spalten auslesen und somit in "meine" Datei importieren kann. Anbei mal der Code.

Option Explicit
' Variablendeklaration
Const strSheetQ As String = "Kunden" ' Der Tabellenblattname in der(n) auszulesenden Dateie(n)
Const strSheetZ As String = "Import" ' Der Tabellenblattname in DIESER Datei (die mit dem Code)
Dim ende As String
Dim antwort As String
' Module    : Modul1
' Procedure : Files_Read
' Author    : Case (Ralf Stolzenburg)
' Date      : 29.10.2013
' Purpose   : Geschlossene Dateien - mehrere Zellen auslesen...
Public Sub Files_Read()
antwort = MsgBox("Daten aus der(n) Dateie(n) importieren?", vbYesNo + vbQuestion, "Hinweis") '  _
Meldung anzeigen und Rückgabewert aus MsgBox speichern
If antwort = vbYes Then ' Wenn nicht abgebrochen, dann weiter mit nachfolgendem Code
' Variablendeklaration
Dim blnUpdate As Boolean
Dim intCalc As Integer
Dim strDir As String
Dim objFSO As Object
Dim objDir As Object
Dim lngCalc As Long
On Error GoTo Fin ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
MsgBox "Das importieren der Informationen kann" & vbCr & "je nach Anzahl an einzulesenden  _
Dateien," & vbCr & " länger dauern." & vbCr & vbCr & "Weiter mit OK", 48, "Information"
' Die Excelapplikation wird ruhig gestellt - Bei z.B. Abbruch UNBEDINGT wieder einschalten!
With Application
.ScreenUpdating = False
blnUpdate = .AskToUpdateLinks
.AskToUpdateLinks = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
' Der Objektvariablen objFSO das "FilesystemObject" zuweisen
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Datei im gleichen Ordner wie Auswertungsdateien
strDir = ThisWorkbook.Path
'strDir = "C:\Temp\Los\"  ' Fester Pfad
Set objDir = objFSO.GetFolder(strDir)
' Der Code bezieht sich auf ein bestimmtes Objekt
' Hier strSheetZ
' Alles was sich auf dieses "With" bezieht MUSS mit einem Punkt beginnen
With ThisWorkbook.Worksheets(strSheetZ)
' Inhalt von Tabelle "strSheetZ" wird ab Zeile 4 gelöscht
.Rows("4:" & .Rows.Count).ClearContents
' Mit Unterordner
'dirInfo objDir, "*.xls*", True ' Mit Unterordner
dirInfo objDir, "*.xlsm*" ' Ohne Unterordner
' Formeln entfernen - Werte bleiben erhalten
.UsedRange.Value = .UsedRange.Value
End With
Fin:
'Schlusscode
ThisWorkbook.Sheets("Import").Range("D2").Value = Date
Call LeerzeilenLoeschenundSortieren
Worksheets("Ergebnis").Select
Call Daten_aus_Import_einlesen
' Setze die Objektvariablen auf Nothing
Set objDir = Nothing
Set objFSO = Nothing
' Die Excelapplikation wieder aufwecken
With Application
.ScreenUpdating = True
.AskToUpdateLinks = blnUpdate
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
MsgBox "Alle vorhandenen Daten aus der(n) Dateie(n) importiert.", 64, "Information"
End If
End Sub
' Module    : Modul1
' Procedure : dirInfo
' Author    : Case (Ralf Stolzenburg)
' Date      : 29.10.2013
' Purpose   : Geschlossene Dateien - mehrere Zellen auslesen...
' Rekursive Sub mit Array - Optional mit Unterordner
Public Sub dirInfo(ByVal objCurrentDir As Object, ByVal strName As String, _
Optional ByVal blnTMP As Boolean = False)
' Variablendeklaration
Dim strFormula As String
Dim lngLastRow As Long
Dim arrCell As Variant
Dim intTMP As Integer
Dim varTMP As Variant
Dim Bereich As Integer ' Für die Anzahl der Zeilen die ausgelesenen werden sollen. Entspricht  _
der Anzahl Kunden die aktuell in der Kundenliste angelegt werden können
Dim BZaehler As Integer ' Für die Schleife zum verschieben der einzufügenden Zellen auf die nä _
chste Zeile
Bereich = 100 ' Anzahl der Zeilen (entspricht der Anzahl Kunden) die ausgelesenen werden  _
sollen
' Alle Dateien im vorgegebenen Ordner
For Each varTMP In objCurrentDir.Files
' Dateiname entspricht den Vorgaben und ist nicht DIESE Datei
If varTMP.Name Like strName And varTMP.Name  _
ThisWorkbook.Name And Left(varTMP.Name, 1)  "~" Then ' und ist KEINE temporäre  _
Datei
' Der Code bezieht sich auf ein bestimmtes Objekt, hier strSheetZ
' Alles was sich auf dieses "With" bezieht MUSS mit einem Punkt beginnen
With ThisWorkbook.Worksheets(strSheetZ)
' Letzte Zeile bezogen auf Spalte A plus 1
lngLastRow = IIf(Len(.Cells(.Rows.Count, 1)), _
.Rows.Count, .Cells(.Rows.Count, 1).End(xlUp).Row) + 1
For BZaehler = 4 To Bereich ' Zeile ab der ausgelesen wird
arrCell = Array("C" & BZaehler, "H" & BZaehler, "A" & BZaehler)
' Schleife über alle Zellen des Arrays
For intTMP = LBound(arrCell) To UBound(arrCell)
' Hier kann noch der Dateiname mit komplettem Pfad in die nächste freie  _
Spalte geschrieben werden
'.Cells(lngLastRow, UBound(arrCell) + 2).Value = varTMP.Path
' Hier kann noch der Dateiname incl. Erweiterung in die nächste freie  _
Spalte geschrieben werden
.Cells(lngLastRow, UBound(arrCell) + 2).Value = varTMP.Name
' Werte über Formel holen, Tabellenblatt über "Const..." oben definiert, _
Zelle über Array. Formel in Spalte A folgende...
.Cells(lngLastRow, intTMP + 1).Formula = "='" & Mid(varTMP.Path, 1, _
InStrRev(varTMP.Path, "\")) & "[" & Mid(varTMP.Path, InStrRev( _
varTMP.Path, "\") + 1) & "]" & strSheetQ & "'!" & arrCell(intTMP)
Next intTMP
lngLastRow = lngLastRow + 1
Next BZaehler
End With
End If
Next varTMP
' Wenn die Variable blnTMP "True" ist (in der Sub "Files_Read_1" vorgegeben dann durchsuche  _
auch alle Unterordner
If blnTMP = True Then
For Each varTMP In objCurrentDir.SubFolders
dirInfo varTMP, strName, blnTMP
Next varTMP
End If
End Sub
Sicherlich würde eine ausgewiesener Excel bzw. VBA Experte den von mir angepassten Code anders/besser schreiben, aber für meine VBA-Kenntnisse habe ich zumindest mein Ergebnis damit erreicht. :-)
Nach dem hier gezeigten Code folgen noch einige weitere Verarbeitungsschritte (Codes) und am Ende habe ich eine, für mein dafürhalten, wunderbare Zusammenfassung. :-)
Viele Grüße
Andreas
Anzeige
Allerbestens - o.w.T
04.07.2017 08:47:13
Case
:-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige