Dateien zusammenfassen
04.03.2016 14:16:41
Sarah
ich stehe vor der Aufgabe Tagesdateien in Monatsdateien und diese wiederrum in eine Jahresdatei zusammenfassen zu müssen um die enthaltenden Werte entsprechend auswerten zu können.
Mit folgenden Schwierigkeiten
- Jede Tagesdatei ist 150 Zeilen lang (inkl. Überschriften)
- wird über die Freigabe von mehreren Kollegen gleichzeitig genutzt
- Wir arbeiten mit einer langsamen Netzwerkverbindung viele Verknüpfungen über einen längeren Zeitraum laufen lassen ist also nicht besonders sinnvoll
Folgende Lösungsansätze hatte ich mir überlegt
- Im Abstand von 149 Zeilen werden die Verknüpfungen bzw. die Pfade der ersten Dateizeile nach dem folgenden Muster gebastelt
"="X='Z:\Unternehmen\"&$BK3&"\Unterordner1\Unterordner2\"&TEXT($BM3;"MM.JJJJ")&"\"&"[VP "&TEXT($BM3;"TT.MM.JJJJ")&".xlsb]"&"Tabelle1'!"&BO$1&$BN3
> in BM3 steht das Datum in BO1 die Bezugsspalte in BN3 die Zeile
- Über das Makro werden dann die vorher generierten Daten eingefügt (Werte und Zahlenformate)
- dann wird der Part X= über Suchen und Ersetzen gegen = ersetzt was die Verknüpfung freischaltet
- dann werden die restlichen 148 Zeilen über Autofill ausgefüllt
- Anschließend wird die Verknüpfung wieder gelöscht
- Dann gehts zum nächsten Tag
So sieht das dann momentan aus: (Nätürlich gekürzt)
Sub Verknüpfungen_aktualisieren_Monat()
' Verknüpfungen_aktualisieren_Monat Makro
Sheets("Tabelle1").Select
Range("BO3:DW3").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="X=", Replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A3:BI151"), Type:=xlFillDefault
Range("A3:BI151").Select
Dim arrLinks
Dim i As Long
arrLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(arrLinks) Then
For i = LBound(arrLinks) To UBound(arrLinks)
If InStr(1, arrLinks(i), "VP 01.", vbTextCompare) > 0 Then _
ActiveWorkbook.BreakLink arrLinks(i), xlLinkTypeExcelLinks
Next i
End If
Range("BO152:DW152").Select
Selection.Copy
Range("A152").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="X=", Replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A152:BI300"), Type:=xlFillDefault
Range("A152:BI300").Select
If Not IsEmpty(arrLinks) Then
For i = LBound(arrLinks) To UBound(arrLinks)
If InStr(1, arrLinks(i), "VP 02.", vbTextCompare) > 0 Then _
ActiveWorkbook.BreakLink arrLinks(i), xlLinkTypeExcelLinks
Next i
End If
Range("BO301:DW301").Select
Selection.Copy
Range("A301").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="X=", Replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A301:BI449"), Type:=xlFillDefault
Range("A301:BI449").Select
If Not IsEmpty(arrLinks) Then
For i = LBound(arrLinks) To UBound(arrLinks)
If InStr(1, arrLinks(i), "VP 03.", vbTextCompare) > 0 Then _
ActiveWorkbook.BreakLink arrLinks(i), xlLinkTypeExcelLinks
Next i
End If
Range("BO450:DW450").Select
Selection.Copy
Range("A450").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="X=", Replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A450:BI598"), Type:=xlFillDefault
Range("A450:BI598").Select
If Not IsEmpty(arrLinks) Then
For i = LBound(arrLinks) To UBound(arrLinks)
If InStr(1, arrLinks(i), "VP 04.", vbTextCompare) > 0 Then _
ActiveWorkbook.BreakLink arrLinks(i), xlLinkTypeExcelLinks
Next i
End If
Das funktioniert soweit auch gut dauert nur leider sehr lange (soll zukünfig mehrmals täglich für aktuelle Daten sorgen). Hätte vielleicht jemand eine elegantere Lösung für diesen zusammengewürfelten Code?
Ich wäre für jeden Input extrem dankbar bin mittlerweile ein bisschen ratlos
Vielen Dank im Voraus
Sarah