Игорь, зря вы так по поводу SQL. Решил, коль целый день делать нечего с имитировать (упрощённо) задачу ТС. Создал два тестовых файла.
1. Users таблица клиентов ([UserName] ФИО - 16 символьное поле; [UserBirthday] Дата ФИО - дата).
2. UserData таблица покупок ([UserName] ФИО - 16 символьное поле; [DateBuy] Дата Покупки - дата; [Ammount] Сумма - плавающее).
Код был следующий
Скрытый текст |
---|
Код |
---|
Public Sub CreateUserTable()
Dim fso As New Scripting.FileSystemObject
Dim userStream As Scripting.TextStream
Dim dataStream As Scripting.TextStream
Dim pFuncs As WorksheetFunction, sDate As String
Dim sUser As String, i As Long, k As Long
Dim bStr(0 To 31) As Byte
Set userStream = fso.CreateTextFile("c:\temp\user.csv", True)
Set dataStream = fso.CreateTextFile("c:\temp\data.csv", True)
Set pFuncs = Application.WorksheetFunction
userStream.WriteLine "UserName,UserBirthday"
dataStream.WriteLine "UserName,DateBuy,Amount"
For i = 1 To 2000000
For k = 0 To 31 Step 2
bStr(k) = CByte(pFuncs.RandBetween(33, 96))
Next
sUser = bStr
sUser = Replace$(sUser, ",", "_"): sUser = Replace$(sUser, """", "_")
sDate = Format$(DateSerial(CInt(pFuncs.RandBetween(1930, 2010)), CInt(pFuncs.RandBetween(1, 12)), CInt(pFuncs.RandBetween(1, 28))), "dd.mm.yyyy")
userStream.WriteLine sUser & "," & sDate
For k = 1 To CLng(pFuncs.RandBetween(3, 9))
sDate = Format$(DateSerial(CInt(pFuncs.RandBetween(1960, 2015)), CInt(pFuncs.RandBetween(1, 12)), CInt(pFuncs.RandBetween(1, 28))), "dd.mm.yyyy")
dataStream.WriteLine sUser & "," & _
sDate & "," & _
Format$(1000# * Rnd, "0.00")
Next
If (i Mod 10000) = 0 Then
DoEvents
Debug.Print i
End If
Next
dataStream.Close: userStream.Close
MsgBox "end"
End Sub
Public Sub AddNotIn()
Dim fso As New Scripting.FileSystemObject
Dim userStream As Scripting.TextStream
Dim dataStream As Scripting.TextStream
Dim pFuncs As WorksheetFunction, sDate As String
Dim sUser As String, i As Long, k As Long
Set pFuncs = Application.WorksheetFunction
Set dataStream = fso.OpenTextFile("c:\temp\data.csv", ForAppending)
For i = 1 To 500000
sUser = ""
For k = 1 To 16
sUser = sUser & Chr(CLng(pFuncs.RandBetween(183, 255)))
Next
For k = 1 To CLng(pFuncs.RandBetween(4, 9))
sDate = Format$(DateSerial(CInt(pFuncs.RandBetween(1960, 2015)), CInt(pFuncs.RandBetween(1, 12)), CInt(pFuncs.RandBetween(1, 28))), "dd.mm.yyyy")
dataStream.WriteLine sUser & "," & _
sDate & "," & _
Format$(1000# * Rnd, "0.00")
Next
If (i Mod 10000) = 0 Then
DoEvents
Debug.Print i
End If
Next
dataStream.Close
End Sub |
|
В Users 2 000 000 записей, в UserData 15 409 218 (часть записей для 500 000 ФИО отсутствует в Users). Собственно, задача отобрать в UserData ФИО, которых нет в Users (естественно, без повторений, так как в UserData могут быть сведения об нескольких покупках одного ФИО). В коде выше добавлены процедурой AddNotIn в UserData.
Попробовал сделать на словарях, вполне возможно, что допустил какую-то некорректность, код ниже, прошу дать оценку
Скрытый текст |
---|
Код |
---|
Public Sub TestDictionary2()
Dim fso As New Scripting.FileSystemObject
Dim pStream As Scripting.TextStream
Dim userDict As New Scripting.Dictionary
Dim notInDict As New Scripting.Dictionary
Dim strOut() As String, readStr As String
Dim sKey As Variant, i As Long, pSheet As Worksheet
Dim t As Single
t = Timer
Set pStream = fso.OpenTextFile("c:\Temp\user.csv", ForReading)
strOut = Split(pStream.ReadAll, vbCrLf)
pStream.Close
For i = 1 To UBound(strOut)
userDict(Left$(strOut(i), 16)) = vbNullString
If (i Mod 10000) = 0 Then
DoEvents
Debug.Print i
End If
Next
Erase strOut
Set pStream = fso.OpenTextFile("c:\Temp\data.csv", ForReading)
strOut = Split(pStream.ReadAll, vbCrLf)
pStream.Close
For i = 1 To UBound(strOut)
readStr = Left$(strOut(i), 16)
If Not userDict.Exists(readStr) Then
notInDict(readStr) = vbNullString
End If
If (i Mod 10000) = 0 Then
DoEvents
Debug.Print i
End If
Next
Erase strOut
ReDim strOut(1 To notInDict.Count, 1 To 1)
i = 0
For Each sKey In notInDict.Keys
i = i + 1
strOut(i, 1) = sKey
Next
Set pSheet = ThisWorkbook.Worksheets.Add
pSheet.Range("A2").Resize(notInDict.Count, 1).Value = strOut
pSheet.Range("A1").Value = "UserName"
pSheet.Range("C1").Value = Timer - t
End Sub
|
|
Подождал некоторое время (минут 15) прервал.
Далее, загнал в Access, проиндексировал обе таблицы по полю UserName, далее следующим кодом получил результат за 65 секунд
Скрытый текст |
---|
Код |
---|
Public Sub CreateWithNonClustered()
Const connStr As String = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Mode=1;Data Source=c:\Projects\Databases\Demo.accdb"
Dim pLO As ListObject, pSheet As Worksheet
Dim t As Single
t = Timer
Set pSheet = ThisWorkbook.Worksheets.Add
Set pLO = pSheet.ListObjects.Add(xlSrcExternal, connStr, True, xlYes, pSheet.Range("A1"))
With pLO.QueryTable
.CommandType = xlCmdSql
.CommandText = "SELECT DISTINCT UserData.UserName FROM UserData LEFT JOIN Users ON UserData.UserName = Users.UserName WHERE Users.UserName Is Null"
.Refresh False
End With
pSheet.Range("C1").Value = Timer - t
End Sub
|
|
Ну, и тоже самое для этих же данных, помещённых в MS SQL LocalDb (естественно с индексами по UserName) - результат получен за 13 секунд
Скрытый текст |
---|
Код |
---|
Public Sub CreateWithNonClustered()
Const connStr As String = "ODBC;Driver={SQL Server Native Client 11.0};Server=(localdb)\mssqllocaldb;Database=SampleDb;Trusted_Connection=yes;"
Dim pLO As ListObject, pSheet As Worksheet
Dim t As Single
t = Timer
Set pSheet = ThisWorkbook.Worksheets.Add
Set pLO = pSheet.ListObjects.Add(xlSrcExternal, connStr, True, xlYes, pSheet.Range("A1"))
With pLO.QueryTable
.CommandType = xlCmdSql
.CommandText = "Select Distinct tud.UserName From dbo.UserDataK tud Left Join dbo.UsersK tu On (tu.UserName=tud.UserName) Where tu.UserName Is Null"
.Refresh False
End With
pSheet.Range("C1").Value = Timer - t
End Sub
|
|
Думаю, для столь объёмных данных выводы очевидны. Не забывайте использовать в базах данных индексы и строить запросы так, чтобы эти индексы задействовались.