title image


Smiley Och, der ist nicht schwer, der Code; Lass mich mal "gaga" spielen und...
ein wenig die Tasten bemühen.



Das Prinzip: Der Teil, der immer wieder benötigt wird, wird in eine andere Sub ausgelagert und dann aufgerufen, wenn er benötigt wird. Um die einzelnen Dateien direkt angeben zu können, habe ich sie hier (im Beispiel ist es nur eine Datei) in einer Collection untergebracht. Wenn "Bracki1" geschrieben hätte, dass die Dateien alle in einem einzigen Verzeichnis liegen, hätte ich ähnlich gearbeitet, wie du es getan hast:



Dim Datei As String

Datei=Dir("d:\irgendwas\*.xls")



Do While Datei""

Call Auslesen(...

Datei=Dir

Loop





Alternativ hätte es auch noch die Möglichkeit über APIs gegeben, wie z. B. FindFile, FindFileNext, etc. oder auch über das von dir genannte FileSystemObject.



Das ist bei einigen wenigen Dateien eigentlich egal und eigentlich Geschmackssache, weil eventuelle 3/10 Sekunden Zeitvorteil irrelevant sind (Ab vielen Dateien sollte es dann aber nicht mehr egal sein).



Also, mein Code geht davon aus, die Dateien selber zu benennen. Um dieses möglichst einfach zu gestalten, packe ich sie einfach in eine Collection, eine Sammlung (die ich auch hätte aus einem Verzeichnisinhalt generieren können).



Wenn die Collection aufgebaut ist, lasse ich einfach für jedes Element die Sub "Auslesen" ausführen. Dazu übergebe ich an diese Sub den Namen des Elementes, den Namen der Originaldatei (die eigentlich fest steht und auch in der Sub "Auslesen" direkt hätte benannt werden können), und schlicht und ergreifend einen Zähler. Anstelle des Zählers hätte ich natürlich auch mit "SpecialCells" die letzte, benutzte Zeile abfragen können und hätte einfach nur eine Zeile dazu gezählt. Nach dem Öffnen der auszulesenden Datei wird der Dateiname umgewandelt, damit nur der Name des Workbooks für den Zugriff auf eben dieses benutzt werden kann. Es wird aus einem bestimmten Sheet ein bestimmter Bereich (A1) ausgelesen und in das zusammenfassende Workbook hineingeschrieben. Danach wird das ausgelesene Workbook eben wieder geschlossen und die aurufende Routine "Start" übernimmt wieder die Kontrolle, die nach der Abarbeitung der Collection das Workbook speichert.



Zur Erklärung:





Sub Start()



Dim col As New Collection 'Collection deklarieren

Dim it As Variant 'Objekt als Variant zum Abfragen der Collection-Items

Dim wborg As String 'Die Variable für das "Workbook original"

Dim wbauslesen As String 'Die Variable, um aus dem Collection-Item einen String zu machen

Dim i As Integer 'Einfache Zählvariable



wborg = "zusammenfassung.xls" 'Das Original-Workbook benennen



With col

.Add "d:\irgendwas.xls" 'Die Collection füllen

.Add "d:\bratkartoffel.xls"

.Add "d:\ealafreyafresena.xls"

.Add "d:\bleifreiesbenzinfüralle.xls"

.Add "e:\irgendwoanders\auchnochmal.xls"

End With



For Each it In col 'Für jedes Element der Collection

i = i + 1 'Zählvariable hochzählen

wbauslesen = CStr(it) 'Item in String umwandeln

Call Auslesen(wbauslesen, wborg, i) 'Sub aufrufen und Argumente übergeben

Next



Workbooks(wborg).Save 'Workbook speichern



End Sub



Sub Auslesen(wbauslesen As String, wborg As String, i As Integer) 'Sub mit Argumenten



Workbooks.Open (wbauslesen) 'Workbook "wbauslesen" öffnen



wbauslesen = Right(wbauslesen, Len(wbauslesen) - InStrRev(wbauslesen, "\", -1)) 'Aus Dateinamen einen Workbooknamen machen



Workbooks(wborg).Sheets("Tabelle1").Cells(i, 1).Value = Workbooks(wbauslesen).Sheets("Tabelle1").Cells(1, 1).Value 'Wert aus "wbauslesen" in "wborg" übertragen



Workbooks(wbauslesen).Close savechanges:=False 'Die ausgelesene Datei wieder schließen ohne zu speichern



End Sub





Tausend Wege führen nach Rom und dieses ist nur einer davon. Egal, wie die Wege aussehen, die die hinführen, funktionieren... ;o)



Gruß aus Ostfriesland. Möge Tux mit Dir sein!

ff


Proggst du schon .net oder quälst du dich noch mit VB6?



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: