Nun habe ich eine Abfrage auf eine Tabelle, die ca. 5500 Datensätze
enthält.
Wenn ich die Abfrage das erste Mal starte, dauert sie rund 5 Sekunden.
Wenn ich sie ein weiteres Mal starte, dauert es rund 20 Sekunden.
So wird das bei jedem Aufruf noch langsamer, bis man in den "mehrere-
Minutenbereich" kommt.
Die Exceldatei an sich wird aber nicht von mal zu mal größer. Sie
bleibt immer gleich groß.
Wenn ich Excel komplett schließe und wieder öffne, geht es wieder ganz
fix.
Ein "SET recordset = Nothing" und "Set connection = Nothing" hat
leider gar nichts gebracht.
Hat mir jemand einen Rat, was ich noch tun kann oder an was das liegt?
Über Hilfe wäre ich sehr dankbar!
Viele Grüße
Martina
Merkwürdig.
> Wenn ich Excel komplett schließe und wieder öffne, geht es wieder ganz
> fix.
Ok. Magst Du uns einmal verraten, wie genau Du über SQL auf Deine Tabellen
zugreifst?
Gehst Du da über das Menü Daten?
Benutzt Du hierzu VBA (und hier wäre dann der Code dazu interessant)?
> Ein "SET recordset = Nothing" und "Set connection = Nothing" hat
> leider gar nichts gebracht.
Klingt nach VBA.
Der Code ist dann aber unerläßlich zur Fehlerdiagnose.
Meine Glaskugel ist nämlich schon ein wenig eingestaubt ;-)
> Hat mir jemand einen Rat, was ich noch tun kann oder an was das liegt?
> Über Hilfe wäre ich sehr dankbar!
Mit mehr Input: vielleicht.
Bis demnächst und
Gruß aus Kiel
Reiner
--
In der Welt der EDV enden Pannen nicht, sondern gehen ineinander über.
Dieses Problem kenne ich von meinen ADO-Abfragen. Vorweg: Es gibt keine
Lösung, ausser Excel zu schliessen und neu zu öffnen.
Die Abfragen dauern immer länger, beobachte auch den Excel-Task im
Taskmanager, da wird auch der verwendete Arbeitsspeicher immer mehr.
Es ist natürlich richtig, alle Variablen zurückzusetzen etc., aber das
löst das Problem nicht.
arno
kurz: ADO aufräumen schadet nicht, beseitigt aber nicht das memory
leak.
http://support.microsoft.com/default.aspx?scid=kb;en-us;319998&Produc
BUG: Memory leak occurs when you query an open Excel worksheet by using
ActiveX Data Objects (ADO)
Zunächst erstmal eine kurze Beschreibung, was mein Programm können
soll:
In einer Exceltabelle ("physicians") befinden sich Stammdaten zu
überweisenden Ärzten (Kürzel, Name, Adresse, Fachgebiet, ...).
Das können durchaus bis zu 10.000 Daten oder mehr sein. Ich teste mit
einer Liste von
rund 5.000 Daten.
Diese Liste soll getestet werden. Am wichtigsten ist der Test, dass
das
Kürzel eindeutig sein soll. Da ein Arzteintrag sich über mehrere
Zeilen
erstrecken kann und das Kürzel kein Pflichtfeld ist, suche ich alle
Ärzte mit demselben Kürzel, aber unterschiedlichem Namen. Diese
fehlerhaften
Daten sollen in einer Liste aufgeführt werden.
Die Tabelle enthält Spaltenüberschriften, die in verschiedene Sprachen
übersetzt werden. Somit muß das ganze recht variabel bleiben.
Ein Kollege von mir hatte das bereits programmiert. Allerdings hat er
das
nicht über SQL gemacht, sondern über diverse Zellenvergleiche. Das ist
aber zum einen nicht immer ganz korrekt, zum anderen dauert das Teil
zu lange.
Es dauert bei 5.000 Datensätzen rund 15 Minuten - eindeutig zu lang.
Nun habe ich es mit SQL auf Exceldaten versucht und konnte das ganze
auf
rund 5 Sekunden senken. Doch leider bleibt die Performance nicht
gleich,
sondern wird immer langsamer.
Die SQL-Abfrage verwendet als Feldnamen die erste Zeile (=
Spaltenüberschriften).
Diese ist bei uns aber unterschiedlich aufgrund der Übersetzungen.
Außerdem enthält die Zeile Bindestriche und Punkte, wodurch die SQL-
Abfrage
nicht funktioniert. Deshalb füge ich eine Zeile ein und erstelle
internationale
Spaltenüberschriften. (Unsere Zellen in Zeile1 enthalten bereits
internale Namen -
diese werden von mir verwendet). Diese Zeile wird am Ende wieder
gelöscht.
Außerdem füge ich zwei Spalten ein. Eine enthält die Zeilennnummer.
Diese benötige
ich für einen Verweis auf die fehlerhafte Zeile. Eine entspr. Funktion
über das
SQL-Statement (rowid o.ä.) habe ich nicht gefunden.
Außerdem wird das Kürzel so umformatiert, dass es auf jeden Fall ein
Characterwert
ist und nicht leer ist.
Die beiden Spalten werden am Ende auch wieder gelöscht, so dass der
Anwender
sie nach der Prüfung nicht sieht.
Mein Programm hat folgenden groben Aufbau:
- Einfügen der ersten Zeile
- Einfügen der beiden Spalten
- SQL-Abfrage
- speichern des Ergebnisses in einer Tabelle
- Löschen der ersten Zeile
- Löschen der beiden Spalten
Wenn ich nur die SQL-Abfrage ausführe und in einer Tabelle speichere
bleibt die
Performance konstant bei rund 3 Sekunden.
Wenn ich nur die Zeilen und Spalten einfüge und wieder lösche (ohne
SQL-Abfrage),
bleibt die Performance konstant bei rund 5 Sekunden.
Wenn ich die erste Zeile einfüge, SQL-Abfrage durchführe und speichere
und Zeile wieder
lösche, ist auch noch alles ok. Auch das Einfügen der beiden Spalten
OHNE INHALT funktioniert noch mit gleichbleibender Performance. Ich
kann in der Loop auch einen Wert hochzählen o.ä.
Aber sobald ich in die Spalten einen Wert schreiben will, geht die
Performance von Aufruf
zu Aufruf in die Knie.
Ich habe auch versucht, erst die Zeile und die beiden Spalten
einzufügen, danach die Tabelle in eine neue Datei zu kopieren und von
dort aus die SQL-Abfrage zu starten, leider ohne Erfolg.
Ich habe keine Idee mehr, was es sein könnte.
Kann mir vielleicht jemand helfen und eine Tipp geben?
(Falls nicht, bin ich ja mit 2 Minuten o.ä. immer noch schneller als
die alte Prüfung,
aber gleichbleibende Performance wäre mir doch lieber.)
So, und wem meine lange Problembeschreibung noch nicht genug ist,
findet unten
noch meinen Programmcode.
Ich danke schon mal allen, die die Geduld hatten, bis hierher alles zu
lesen!
Viele Grüße
Martina
---------------------------------------------------
Dim iColumnCount As Long
Dim countErrors As Long
Dim FirstRowforSQLexists_jn As String 'j if first line for SQL
statement was inserted
'by function
insert_first_row_for_sql
Dim FirstColumnforSQLexists_jn As String 'j if first column for SQL
statement was inserted
'by function
insert_column_rownumber
Dim wsSQLResult As Object
Dim wsCheckSheet As Object
Sub test_check_aerzteunique()
Dim DB_connection As New ADODB.Connection
Dim DB_recordset As New ADODB.Recordset
Dim DB_result As Variant
Dim i As Long
Dim CheckTable_Physicians As String
Dim data_received_jn As String
Dim iSQLResult As Long
Application.ScreenUpdating = False
FirstRowforSQLexists_jn = "n"
FirstColumnforSQLexists_jn = "n"
countErrors = 0
CheckTable_Physicians = "physicians"
Set wsCheckSheet =
Application.ActiveWorkbook.Worksheets(CheckTable_Physicians)
'insert first row with column names for preparing SQL statements
insert_first_row_for_sql (CheckTable_Physicians)
If countErrors > 0 Then
Exit Sub
End If
'insert two columns with rownumber and physician code in string
format
' - important for SQL statement
insert_column_rownumber CheckTable_Physicians, "physicians"
'open data connection to Excel sheet
DB_connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & Application.ActiveWorkbook.FullName _
& ";Extended Properties=Excel 8.0;"
'SQL statement
'Searches for all physicicans with the same code but different
' name. The code has to be unique.
'It is possible that one physician has more than one row.
'And it is possible that the code is empty.
DB_recordset.Open "SELECT distinct a1.physicians_rownum, " & _
"a1.physicians_code_str " & _
"FROM [" & CheckTable_Physicians & "$] a1, " & _
"[" & CheckTable_Physicians & "$] a2 " & _
"Where a1.physicians_code_str = a2.physicians_code_str " & _
"And a1.physicians_name <> a2.physicians_name " & _
"order by a1.physicians_code_str, a1.physicians_rownum; ", _
DB_connection, adOpenKeyset, adLockOptimistic
If Not DB_recordset.EOF Then
'if data were found
data_received_jn = "j"
'assign result to variable DB_result
DB_result = DB_recordset.GetRows
Else
'if no data were found
data_received_jn = "n"
End If
DB_recordset.Close
'to eliminate it completely from memory
Set DB_recordset = Nothing
Set wsSQLResult =
Application.ActiveWorkbook.Worksheets("sql_result")
'write result in table sql_result.
iSQLResult = 0
If data_received_jn = "j" Then
For i = 1 To UBound(DB_result, 2) + 1
wsSQLResult.Cells(i, 1) = DB_result(0, i - 1)
wsSQLResult.Cells(i, 2) = DB_result(1, i - 1)
iSQLResult = iSQLResult + 1
Next
End If
DB_connection.Close
Set DB_connection = Nothing
delete_first_row (CheckTable_Physicians)
delete_first_column CheckTable_Physicians, "physicians"
Set wsCheckSheet = Nothing
Set wsSQLResult = Nothing
Set wsCheckSheet = Nothing
Set DB_result = Nothing
Application.ScreenUpdating = True
End Sub
' Working with SQL on a Excel data sheet the table columns for the
select
' statement are used from the first line of the Excel sheet(s).
' As we have to consider translation/internationalisation here, the
best is
' to use the cell name of the columns (cell names of the cells of the
first line).
' But they include a colon (.), which does not work with the SQL
statement.
' Therefore this is replaced to an underline (_).
Sub insert_first_row_for_sql(CheckTable_Str As String)
Dim iColNum As Long
Dim ColumnName As String
On Error GoTo end_insert_first_row_for_sql
wsCheckSheet.Activate
Rows("1:1").Select
'Insert a new row at the first line ...
Selection.Insert Shift:=xlDown
FirstRowforSQLexists_jn = "j"
wsCheckSheet.Range("A1").Select
iColumnCount =
wsCheckSheet.Columns.SpecialCells(xlCellTypeLastCell).Column
'If this function is performed several times for the same table,
'so that the first line is inserted and deleted several times
'without saving the file, there is a Excel problem that Excel can
not
'find the last column correctly.
'Therefore the last column with content will be searched.
While Trim(wsCheckSheet.Cells(2, iColumnCount).Value) = ""
iColumnCount = iColumnCount - 1
Wend
'... and fill it with the cell names of the old first row (header
row)
For iColNum = 1 To iColumnCount
ColumnName = wsCheckSheet.Cells(2, iColNum).Name.Name
wsCheckSheet.Cells(1, iColNum).Value = Replace(ColumnName,
".", "_")
Next
wsCheckSheet.Range("A1").Select
Exit Sub
end_insert_first_row_for_sql:
'There is for example an error if the header row or one of its
cells
' does not contain cell names. Then the statement
' ColumnName = wsCheckSheet.Cells(2, iColNum).Name.Name
' leads to an error
MsgBox ("Error on
check_procedure2costcentre.insert_first_row_for_sql")
countErrors = countErrors + 1
If FirstRowforSQLexists_jn = "j" Then
delete_first_row (CheckTable_Str)
End If
End Sub
Sub delete_first_row(CheckTable_Str As String)
wsCheckSheet.Activate
Rows("1:1").Select
Selection.Delete Shift:=xlUp
FirstRowforSQLexists_jn = "n"
wsCheckSheet.Range("A1").Select
End Sub
'As the rownumber shall be displayed in the log table,
' a new column shall be inserted filled with the rownumbers.
' (did not find a possibility to select it in SQL statement)
Sub insert_column_rownumber(CheckTable_Str As String, _
prefix_rownum As String)
Dim iRowNum As Long, iRowCount As Long
On Error GoTo end_insert_column_rownumber
iRowCount = wsCheckSheet.Rows.SpecialCells(xlCellTypeLastCell).Row
wsCheckSheet.Activate
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
If prefix_rownum = "physicians" Then
'Insert a second column for the code in string/character
format
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End If
FirstColumnforSQLexists_jn = "j"
Range("A1").Select
'The cell A1 has to include the column name, so that it is
' possible to use this column in the SQL statement
wsCheckSheet.Cells(1, 1).Value = prefix_rownum & "_rownum"
wsCheckSheet.Cells(1, 2).Value = prefix_rownum & "_code_str"
'The second row has to be row number 1 as the first row will
'be deleted after the SQL check
For iRowNum = 2 To iRowCount
wsCheckSheet.Cells(iRowNum, 1).Value = iRowNum - 1
'As there could be problems if the code contains only numbers
or if they are imported/copied,
' they shall be definetly formated as string value
If prefix_rownum = "physicians" Then
wsCheckSheet.Cells(iRowNum, 2).NumberFormat = "@"
wsCheckSheet.Cells(iRowNum, 2).FormulaR1C1 =
LTrim(RTrim(UCase(CStr(wsCheckSheet.Cells(iRowNum, 3).Value))))
'Empty codes are possible, so they have to be replaced
with an unique string for the test
If wsCheckSheet.Cells(iRowNum, 2).Value = "" Then
wsCheckSheet.Cells(iRowNum, 2).Value = CStr("XYZ" &
iRowNum)
End If
End If
Next
Exit Sub
end_insert_column_rownumber:
MsgBox ("Error on
check_procedure2costcentre.insert_column_rownumber")
countErrors = countErrors + 1
If FirstColumnforSQLexists_jn = "j" Then
delete_first_column CheckTable_Str, prefix_rownum
End If
End Sub
Sub delete_first_column(CheckTable_Str As String, _
prefix_rownum As String)
wsCheckSheet.Activate
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
If prefix_rownum = "physicians" Then
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
End If
FirstColumnforSQLexists_jn = "n"
wsCheckSheet.Range("A1").Select
End Sub
--------------------------
Wer kam auf die Idee so viele Daten (auch noch über mehrere Zeilen gehend
*gräusel*) in einer Excel-Tabelle zu verwalten? Imho etwas für eine
Datenbank!
> Nun habe ich es mit SQL auf Exceldaten versucht und konnte das ganze auf
> rund 5 Sekunden senken. Doch leider bleibt die Performance nicht gleich,
> sondern wird immer langsamer.
> Die SQL-Abfrage verwendet als Feldnamen die erste Zeile (=
> Spaltenüberschriften).
> Diese ist bei uns aber unterschiedlich aufgrund der Übersetzungen.
Imho sollte man die Datenhaltung von der Benutzerschnittstelle unabhängig
halten. Dann hättest Du dieses Problem nicht.
> Außerdem füge ich zwei Spalten ein. Eine enthält die Zeilennnummer. Diese
> benötige ich für einen Verweis auf die fehlerhafte Zeile. Eine entspr.
> Funktion über das SQL-Statement (rowid o.ä.) habe ich nicht gefunden.
Dann hilft Dir dabei vielleicht FAQ 3.11 auf www.donkarl.com weiter.
> Außerdem wird das Kürzel so umformatiert, dass es auf jeden Fall ein
> Characterwert ist und nicht leer ist.
Diese Umformatierung sollte entweder gar nicht notwendig sein oder bereits
im SQL-Statement erledigt werden können.
Hierzu könnte Dir IIF weiterhelfen.
> Mein Programm hat folgenden groben Aufbau:
> - Einfügen der ersten Zeile
> - Einfügen der beiden Spalten
> - SQL-Abfrage
> - speichern des Ergebnisses in einer Tabelle
> - Löschen der ersten Zeile
> - Löschen der beiden Spalten
Probier als allerletzten Schritt doch einmal ein Speichern des Dokumentes
aus. Vielleicht hilft das die Performance gleich zu halten.
> Wenn ich nur die SQL-Abfrage ausführe und in einer Tabelle speichere
> bleibt die Performance konstant bei rund 3 Sekunden.
Ok.
> Wenn ich nur die Zeilen und Spalten einfüge und wieder lösche (ohne
> SQL-Abfrage), bleibt die Performance konstant bei rund 5 Sekunden.
Ok.
> Wenn ich die erste Zeile einfüge, SQL-Abfrage durchführe und speichere
> und Zeile wieder lösche, ist auch noch alles ok. Auch das Einfügen der
> beiden Spalten OHNE INHALT funktioniert noch mit gleichbleibender
> Performance. Ich kann in der Loop auch einen Wert hochzählen o.ä.
Ok.
> Aber sobald ich in die Spalten einen Wert schreiben will, geht die
> Performance von Aufruf zu Aufruf in die Knie.
Ich könnte mir vorstellen, dass der Jet-Provider von der gespeicherten
Datei ausgeht und die restlichen Änderungen jedesmal "hinzudenken" muss.
Das würde das beschriebene Verhalten zumindest erlkären.
Daher auch mein Speichernvorschlag von oben.
> So, und wem meine lange Problembeschreibung noch nicht genug ist, findet
> unten noch meinen Programmcode.
> Ich danke schon mal allen, die die Geduld hatten, bis hierher alles zu
> lesen!
Ja, ich habe mich durchgekämpft ;-)
Falls Du Kommentare zu Deinem Code haben möchtest, dann liest auch Du
einfach weiter :-)
Ansonsten
Gruß aus Kiel
Reiner
^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^
Vorschlag: adOpenForwardOnly, adLockReadOnly
> If Not DB_recordset.EOF Then
> 'if data were found
> data_received_jn = "j"
> 'assign result to variable DB_result
> DB_result = DB_recordset.GetRows
Zum hinzufügen ins Tabellenblatt würde ich Dir die
CopyFromRecordset-Methode des Range-Objektes empfehlen ...
> 'write result in table sql_result.
> iSQLResult = 0
> If data_received_jn = "j" Then
> For i = 1 To UBound(DB_result, 2) + 1
> wsSQLResult.Cells(i, 1) = DB_result(0, i - 1)
> wsSQLResult.Cells(i, 2) = DB_result(1, i - 1)
> iSQLResult = iSQLResult + 1
> Next
> End If
... damit würde die For-Schleife überflüssig werden.
> Sub insert_first_row_for_sql(CheckTable_Str As String)
> Dim iColNum As Long
> Dim ColumnName As String
>
> On Error GoTo end_insert_first_row_for_sql
>
>
> wsCheckSheet.Activate
> Rows("1:1").Select
Wenn Du dem Benutzer nicht etwas zeigen willst, solltest Du auf Activate-
und Select-Anweisungen verzichten.
Du kannst sie [(fast)] immer vermeiden und sie verlangsamen den Codeablauf.
> 'Insert a new row at the first line ...
> Selection.Insert Shift:=xlDown
Schreibe stattdessen kürzer, besser, schneller:
wsCheckSheet.Rows("1:1").Insert Shift:=xlDown
> FirstRowforSQLexists_jn = "j"
> wsCheckSheet.Range("A1").Select
Den Grund für dieses 'Select' habe ich überhaupt nicht gefunden.
> iColumnCount =
> wsCheckSheet.Columns.SpecialCells(xlCellTypeLastCell).Column
>
> 'If this function is performed several times for the same table,
> 'so that the first line is inserted and deleted several times
> 'without saving the file, there is a Excel problem that Excel can
> not
> 'find the last column correctly.
> 'Therefore the last column with content will be searched.
> While Trim(wsCheckSheet.Cells(2, iColumnCount).Value) = ""
> iColumnCount = iColumnCount - 1
> Wend
>
> '... and fill it with the cell names of the old first row (header
> row)
> For iColNum = 1 To iColumnCount
> ColumnName = wsCheckSheet.Cells(2, iColNum).Name.Name
> wsCheckSheet.Cells(1, iColNum).Value = Replace(ColumnName,
> ".", "_")
> Next
>
> wsCheckSheet.Range("A1").Select
Das Select mag ich noch verstehen. Wenn man aber die Auswahl gar nicht erst
woanders hinsetzt, hat der Benutzer sie einfach noch da, wo er sie
"verlassen" hat.
[schnippel]
> Sub delete_first_row(CheckTable_Str As String)
>
> wsCheckSheet.Activate
> Rows("1:1").Select
> Selection.Delete Shift:=xlUp
Die 3 Zeilen kürzer:
wsCheckSheet.Rows("1:1").Delete Shift:= xlUp
[restlichen Code gesnippt]
Der Rest könnte lediglich um die gleichen Dinge bereinigt werden.
--
Wissen ist Macht -
Nichts wissen macht nichts!