Datensammeln von Server
19.05.2016 17:47:36
Server
Ich bin kein VBA Profi und dieses Forum hat mir schon bei so manchen Sachen geholfen (als stiller Nutznießser ;) ). Ich stehe vor der Aufgabe Daten aus mehreren Quelltabellen in eine einzige Zieltabelle zu poolen. Dieses Rad ist ja schon mehrfach erfunden worden und ich nutze momentan dieses Makro:
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , _
xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub E_auslesen()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object, strIn _
As String, strOut As String
'** Angaben zur auszulesenden Zelle
pfad = "\\SERVER\ORDNER$\UNTERORDNER"
datei = "QUELLE1.xlsx"
blatt = ActiveSheet.Range("K6").Value
strOut = "XXX"
strIn = ""
Range("L2").FormulaArray = "=MAX(ROW(13:65535)*('[" & datei & "]" & blatt & "'!A13:A65535"""") _
)"
Set bereich1 = Range("A13:A" & Range("L2").Value)
Set bereich2 = Range("B13:A" & Range("L2").Value)
Set bereich3 = Range("C13:A" & Range("L2").Value)
Set bereich4 = Range("D13:A" & Range("L2").Value)
Application.ScreenUpdating = False
'** Bereich auslesen
For Each zelle In bereich1
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
For Each zelle In bereich2
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
For Each zelle In bereich3
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
For Each zelle In bereich4
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
' Überflüssiges aus den Zellen entfernen
bereich1.Select
Selection.Replace What:=strOut, Replacement _
:=strIn, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Application.ScreenUpdating = True
End Sub
Wie man sehen kann habe ich vier Quellspalten mit Standardtext. Die Daten werden korrekt übertragen. Allerdings werden gleichzeitig sich automatisch aktualisierende Verknüpfungen gesetzt, die bei jedem Start der Zieltabelle eine Aktualisierung anfragen. Das wollte ich eigentlich durch die Verwendung von Makros umgehen, damit andere Nutzer der Zieltabelle damit nicht belästigt werden. Kann ich das irgendwo abschalten? Eigentlich braucht Excel die Verknüpfungen doch auch gar nicht. Die Quelle definiere ich doch mit dem Ausführen des Makros(?)
Dann habe ich öfter das Problem, dass das Makro hier
Range("L2").FormulaArray = "=MAX(ROW(13:65535)*('[" & datei & "]" & blatt & "'!A13:A65535""""))"
nach der Excel-Datei fragt, obwohl Pfad und Datei korrekt definiert sind. Beim Abbrechen gibts die Fehlermeldung "Typen inkompatibel". Kann das an einem lahmen Server liegen, auf dem die Quelltabellen liegen? Bisher kann ich das so lösen, dass ich die Quelltabelle einmal öffne und schließe. Danach kann ich das Makro problemlos ausführen (nur dann könnte ich ja auch normal kopieren).
Zu guter Letzt ... Das Makro könnte gerne schneller laufen. Für das Einlesen von vier Spalten mit jeweils weniger als 300 Einträgen brauche ich schon 23 Minuten. Ich fürchte, dass es an den beiden bedingten Formatierungen liegt, die jede der vier Zielspalten "besitzt"(?) Diese nutze ich um Inkonsistenzen zwischen dem aktuell eingelesen und dem vorherigen Stand sichtbar zu machen (nach einem Abgleich kopiert Excel die vier Spalten in weitere vier "Status Quo" Spalten).
Über Vorschläge zur Optimierung meines Makros wäre ich dankbar :)
Grüße,
Philipp