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

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

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

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

Public Sub ClosePensSprav(FileName As String)

Dim txtFile As TextStream

Dim TmpString As String

Dim Ndx As Long

Dim lLowVal As Long

Dim lHighVal As Long

Dim lStep As Long

    If Not (FSO.FileExists(FileName)) Then FSO.CreateTextFile (FileName)

    Set txtFile = FSO.OpenTextFile(FileName, ForWriting)

    lHighVal = PensSprav.Count

    lStep = CLng(lHighVal / 100)

    For Ndx = 0 To PensSprav.Count - 1

        lLowVal = Ndx

        If lLowVal Mod lStep = 0 Then Application.StatusBar = "Сохранение справочника:" & FSO.GetFileName(FileName) & ": " & sObrStr(lLowVal, lHighVal) & sSuff(CInt(lLowVal / lHighVal * 100))

        TmpString = PensSprav.Keys(Ndx) & "|" & PensSprav.Items(Ndx)

        txtFile.WriteLine (TmpString)

        DoEvents

    Next Ndx

    txtFile.Close

    Application.StatusBar = False

    Set txtFile = Nothing

    Set PensSprav = Nothing

End Sub