Re: Performance von SQL-Abfragen auf Exceltabellen

Hallo,
ich habe das Performance-Problem nochmal genauer getestet und bin
nun doch etwas ratlos.

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 wsCheck*** 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 wsCheck*** =
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 ***
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 wsCheck*** = Nothing
Set wsSQLResult = Nothing
Set wsCheck*** = Nothing
Set DB_result = Nothing

Application.ScreenUpdating = True
End Sub

' Working with SQL on a Excel data *** the table columns for the
select
' statement are used from the first line of the Excel ***(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


wsCheck***.Activate
Rows("1:1").Select

'Insert a new row at the first line ...
Selection.Insert Shift:=xlDown

FirstRowforSQLexists_jn = "j"

wsCheck***.Range("A1").Select

iColumnCount =
wsCheck***.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(wsCheck***.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 = wsCheck***.Cells(2, iColNum).Name.Name
wsCheck***.Cells(1, iColNum).Value = Replace(ColumnName,
".", "_")
Next

wsCheck***.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 = wsCheck***.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)

wsCheck***.Activate
Rows("1:1").Select
Selection.Delete Shift:=xlUp
FirstRowforSQLexists_jn = "n"
wsCheck***.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 = wsCheck***.Rows.SpecialCells(xlCellTypeLastCell).Row

wsCheck***.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
wsCheck***.Cells(1, 1).Value = prefix_rownum & "_rownum"
wsCheck***.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
wsCheck***.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
wsCheck***.Cells(iRowNum, 2).NumberFormat = "@"
wsCheck***.Cells(iRowNum, 2).FormulaR1C1 =
LTrim(RTrim(UCase(CStr(wsCheck***.Cells(iRowNum, 3).Value))))
'Empty codes are possible, so they have to be replaced
with an unique string for the test
If wsCheck***.Cells(iRowNum, 2).Value = "" Then
wsCheck***.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)

wsCheck***.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"
wsCheck***.Range("A1").Select
End Sub
--------------------------

.