Добрый день всем!
Есть *.dbf файл содержащий ~250000 записей с множеством полей размером ~700 МБ.
Необходимо по значению двух полей найти запись и подставить в Excel значение трех других полей.
Использую VFPODBC. Первоначально при каждом поиске создавал Recordset, а в sql-запросе указывал условие поиска.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
Dim strcon2 As String
Dim strsql2 As String
Dim cn2 As ADODB.Connection
Dim rs2 As ADODB.Recordset
Dim spv As String
Dim npv As String
Dim timef As Date
nLen = Len(Target.Value)
If (nLen >= 10) Then
npv = Right(Target.Value, 6)
spv = Left(Target.Value, nLen - 6)
strcon2 = "Driver={Microsoft Visual FoxPro Driver};UID=;SourceType=DBF;Exclusive=No;Background-dFetch=Yes;Collate=Russian;Null=No;Deleted=Yes;SourceDB=c:\xx\Basa;"
Set cn2 = New ADODB.Connection
cn2.ConnectionString = strcon2
cn2.Open
strsql2 = "select R24, R25, R26 from vxxx.dbf where r55='" & spv & "' and r56='" & npv & "'"
Set rs2 = New ADODB.Recordset
timef = Time()
rs2.Open strsql2, cn2, adOpenKeyset, adLockOptimistic
timef = Time() - timef
Application.StatusBar = "Готово. Время выполнения: " & timef
Do Until rs2.EOF
Cells(Target.Row, 10).Value = Trim(rs2.Fields("R24").Value)
Cells(Target.Row, 11).Value = Trim(rs2.Fields("R25").Value)
Cells(Target.Row, 12).Value = Trim(rs2.Fields("R26").Value)
rs2.MoveNext
Loop
rs2.Close
cn2.Close
Set rs2 = Nothing
Set rs2 = Nothing
End If
Время выполнения запроса на Atom N270 1GB RAM - от 20 до 40 секунд.
Сейчас открываю Recordset с SQL запросом без условия при открытии документа. А ищу нужную запись накладыванием фильтра на Recordset.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
Private Sub Workbook_Open()
Dim ConnectionString2 As String
Dim SQLString2 As String
Dim TimeFlag As Date
ConnectionString2 = "Driver={Microsoft Visual FoxPro Driver};UID=;SourceType=DBF;Exclusive=No;Background-dFetch=Yes;Collate=Russian;Null=No;Deleted=Yes;SourceDB=c:\xx\Basa;"
SQLString2 = "select R24, R25, R26, R55, R56 from vxxx.dbf order by r55, r56"
Set rs2 = New ADODB.Recordset
Application.DisplayStatusBar = True
Application.StatusBar = "Открываем набор записей!"
Application.ScreenUpdating = False
TimeFlag = Time()
With rs2
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open SQLString2, ConnectionString2, adCmdText
End With
TimeFlag = Time() - TimeFlag
Application.StatusBar = "Время открытия набора записей: " & TimeFlag
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Count = 1) Then
If (Target.Column = 14 And Target.Value <> "") Then
Dim spv As String
Dim npv As String
Dim timef As Date
nLen = Len(Target.Value)
If (nLen >= 10) Then
npv = Right(Target.Value, 6)
spv = Left(Target.Value, nLen - 6)
timef = Time()
rs2.Filter = "r55='" & spv & "' AND r56='" & npv & "'"
timef = Time() - timef
Application.StatusBar = "Готово. Время выполнения: " & timef
Application.ScreenUpdating = True
'MsgBox rs2.GetString
Do Until rs2.EOF
Cells(Target.Row, 10).Value = Trim(rs2.Fields("R24").Value)
Cells(Target.Row, 11).Value = Trim(rs2.Fields("R25").Value)
Cells(Target.Row, 12).Value = Trim(rs2.Fields("R26").Value)
rs2.MoveNext
Loop
End If
End If
End If
End Sub
Документ дольше открывается, занимает больше памяти. Но поиск записи выполняется за ~8 секунд.
Есть ещё одна таблица, по объёму в два раза больше, количество записей не знаю. По второй таблице поиск осуществляется за ~15 секунд.
Как можно ускорить поиск в *.dbf?
Как указать индексный файл при использовании VFPODBC? Наличие файла ускорит поиск в первоначальном варианте?
При положительном ответе на предыдущий вопрос, как создать индексный файл VBS-скриптом с использованием VFPODBC драйвера?
