Sub RunChrome(ByVal url As Variant)
    Dim v As Variant
    With CreateObject("WScript.Shell")
        On Error Resume Next
        For Each v In url
            Shell """" & .RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\") & _
                """ --new-window """ & IIf(IsEmpty(v), url, v) & """"
        Next
    End With
End Function
Sub RunFirefox(ByVal url As Variant)
    Dim v As Variant
    With CreateObject("WScript.Shell")
        On Error Resume Next
        For Each v In url
            Shell """" & .RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\firefox.exe\") & _
                """ -new-window """ & IIf(IsEmpty(v), url, v) & """"
        Next
    End With
End Function

RunChrome array("https://www.youtube.com/?gl=RU&hl=ru","http://www.excelworld.ru/forum/2")

Private WithEvents QT As QueryTable
Private Sub QT_BeforeRefresh(Cancel As Boolean)
    QT.Connection = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties=""excel 12.0 macro;hdr=no"";Data Source=" & ThisWorkbook.FullName
    DoEvents
End Sub
Private Sub Workbook_Open()
    Set QT = [Запрос].ListObject.QueryTable
End Sub

Private WithEvents app As Application
Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo er
    Dim LastSaved$, Backup$
    LastSaved = Wb.BuiltinDocumentProperties("Last Save Time")
    Backup = Wb.Path & "\" & Replace(LastSaved, ":", ".") & " " & Wb.Name
    If Wb Is Me Or Wb.IsAddin Then Exit Sub
    If Wb.FullName <> Wb.Name And Not SaveAsUI And MsgBox("Сделать бэкап?", 36) = 6 Then
        Shell Join(Array("cmd /c copy ", Wb.FullName, " ", Backup, " /y"), """")
        Do While Dir$(Backup) = ""
            DoEvents
        Loop
    ElseIf SaveAsUI Then
        MsgBox "Тут можно чего-то написать"
    End If
er:
End Sub
Private Sub Workbook_Open()
    Set app = Application
End Sub

Public Function РеальноеВремя()
    Application.Volatile True
    РеальноеВремя = Now
End Function

Private Sub Workbook_Open()
    With Лист1.Cells.Find("РеальноеВремя", , xlFormulas, xlPart)
        .Formula = .Formula
    End With
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Formula = "=РеальноеВремя()" Then recalc Target.Address(, , , 1)
End Sub
Public Sub recalc(adr)
    If Range(adr).Formula = "=РеальноеВремя()" Then
        Range(adr).Calculate
        Application.OnTime Now + TimeSerial(0, 0, 1), "'" & ThisWorkbook.Name & "'!'ЭтаКнига.recalc """ & adr & """'"
    End If
End Sub

Sub AddQT()
    Dim varConn$, varSQL$, wsh As Worksheet
    varConn = "ODBC;DSN=MS Access Database;DBQ=\\HYPERV\data\SDAT.mdb;Driver={Driver do Microsoft Access (*.mdb)}"
    varSQL = "SELECT SatAlici, SatNote FROM T_Satish WHERE (T_Satish.SatAlici  = ?)"
    Set wsh = ActiveSheet
    With wsh
        .[AN2].CurrentRegion.Delete xlUp
        With .QueryTables.Add(varConn, .[AN2], varSQL).Parameters.Add("p1", 4)
            .SetParam 2, wsh.[A1]
            .RefreshOnChange = True
            .Parent.Parent.Refresh
        End With
    End With
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case True
        Case Sh Is Me.Sheets(1) And Target.Address = "$A$1"
            Me.Sheets(2).Range("B1").Formula = Target
        Case Else
            Exit Sub
    End Select
End Sub

"SELECT  SatAlici, max(SatNote), max(SatMalID) FROM T_Satish WHERE (T_Satish.SatAlici  = ?) group by T_Satish.SatAlici"

filling arraylist with 10^6 random numbers took 10,6250 seconds
sorting 10^6 random numbers in ascending order with Arraylist took 1,3906 seconds
sorting 10^6 random numbers in descending order with Arraylist took 1,4375 seconds
filling dictionary with 10^6 random numbers took 72,2813 seconds
sorting 10^6 random numbers in descending order with quicksort took 7,3203 seconds
filling collection with 10^6 random numbers took 0,2188 seconds

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type FILETIMES
    CreationTime As FILETIME
    LastAccessTime As FILETIME
    LastWriteTime As FILETIME
End Type
Private Declare PtrSafe Function CreateFile _
    Lib "kernel32" _
    Alias "CreateFileA" ( _
        ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, _
        ByVal lpSecurityAttributes As Long, _
        ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As LongPtr _
    ) As LongPtr
Private Declare PtrSafe Function GetFileTime _
    Lib "kernel32" ( _
        ByVal hFile As LongPtr, _
        lpCreationTime As FILETIME, _
        lpLastAccessTime As FILETIME, _
        lpLastWriteTime As FILETIME _
    ) As Long
Private Declare PtrSafe Function SetFileTime Lib "kernel32" ( _
    ByVal hFile As LongPtr, _
    lpCreationTime As FILETIME, _
    lpLastAccessTime As FILETIME, _
    lpLastWriteTime As FILETIME _
) As Long
Private Declare PtrSafe Function GetFileAttributes _
    Lib "kernel32.dll" _
    Alias "GetFileAttributesA" ( _
        ByVal lpFileName As String _
    ) As Long
Public Declare PtrSafe Function SetFileAttributes _
    Lib "kernel32.dll" _
    Alias "SetFileAttributesA" ( _
        ByVal lpFileName As String, _
        ByVal dwFileAttributes As Long _
    ) As Long
Private Declare PtrSafe Function CloseHandle _
    Lib "kernel32" ( _
        ByVal hObject As LongPtr _
    ) As Long
Private Declare PtrSafe Function GetLastError _
    Lib "kernel32" ( _
    ) As Long

Private Const _
    GENERIC_WRITE& = &H40000000, _
    GENERIC_READ& = &H80000000, _
    OPEN_EXISTING& = 3, _
    FILE_SHARE_READ& = &H1, _
    INVALID_HANDLE_VALUE& = -1, _
    zip$ = "c:\UsefulSoft\WinRAR\Rar.exe"

Public Function ReadFromfile(strFilePath, ByRef FT As FILETIMES, ByRef hFileAttr&, p1, ByRef p2 As Variant) As Boolean
    Dim hFile&
    'читаем встроенные свойства исходного файла
    With p1
        On Error Resume Next
        p2(1) = .Item(7): p2(2) = .Item(8)
        p2(3) = .Item(9): p2(4) = .Item(11)
        p2(5) = .Item(12): p2(6) = .Item(13)
        Err.Clear
    End With
    'создаем файловый дескриптор, указывающий на исходный файл
    hFile = CreateFile(strFilePath, GENERIC_READ, FILE_SHARE_READ, 0&, OPEN_EXISTING, 1, 0&)
    If hFile <> INVALID_HANDLE_VALUE Then
        'читаем датувремя создания, открытия, сохранения файла
        GetFileTime hFile, FT.CreationTime, FT.LastAccessTime, FT.LastWriteTime
        'читаем атрибуты файла
        hFileAttr = GetFileAttributes(strFilePath)
        'закрываем дескриптор
        CloseHandle hFile
        ReadFromfile = (Err.Number + GetLastError) = 0
    End If
End Function
Public Function write2file(strNewFilePath$, FT As FILETIMES, hFileAttr&, p2 As Variant) As Boolean
    Dim hFile&, objTimeZone, TZOffset#
    On Error Resume Next
    'определяем часовой пояс
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
        For Each objTimeZone In .ExecQuery("Select * from Win32_TimeZone")
            TZOffset = objTimeZone.Bias / 1440
        Next
    End With
    'заменяем встроенные свойства скопированного файла
    With CreateObject("wscript.shell")
        Err.Clear
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ x """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ x """ & _
             strNewFilePath & """ docProps\core.xml -y""", 0, 1
        With CreateObject("MSXML2.DOMDocument.6.0")
            .async = False: .validateOnParse = False
            .Load Environ("tmp") & "\docProps\core.xml"
            If Not IsEmpty(p2(1)) Then _
                .SelectSingleNode("//*[local-name()='lastModifiedBy']").Text = p2(1)
            If Not IsEmpty(p2(2)) Then _
                .SelectSingleNode("//*[local-name()='revision']").Text = p2(2)
            If Not IsEmpty(p2(4)) Then _
                .SelectSingleNode("//*[local-name()='created']").Text = _
                    Format(p2(4) - TZOffset, "yyyy-mm-ddTHH:MM:SSZ")
            If Not IsEmpty(p2(5)) Then _
                .SelectSingleNode("//*[local-name()='modified']").Text = _
                    Format(p2(5) - TZOffset, "yyyy-mm-ddTHH:MM:SSZ")
            .Save Environ("tmp") & "\docProps\core.xml"
            .Load Environ("tmp") & "\docProps\app.xml"
            If Not IsEmpty(p2(3)) Then _
                .SelectSingleNode("//*[local-name()='Application']").Text = p2(3)
            If Not IsEmpty(p2(6)) Then _
                .SelectSingleNode("//*[local-name()='TotalTime']").Text = p2(6)
            .Save Environ("tmp") & "\docProps\app.xml"
        End With
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ u """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        .Run "%comspec% /c ""cd ""%tmp%""&&""" & zip & """ u """ & _
             strNewFilePath & """ docProps\app.xml -y""", 0, 1
        Kill Environ("tmp") & "\docProps\*.*"
        RmDir Environ("tmp") & "\docProps"
    End With
    'создаем файловый дескриптор, указывающий на конвертированный файл
    hFile = CreateFile(strNewFilePath, GENERIC_WRITE, 0&, 0&, OPEN_EXISTING, 0&, 0&)
    If hFile <> INVALID_HANDLE_VALUE& Then
        'заменяем датувремя создания, открытия, сохранения файла
        SetFileTime hFile, FT.CreationTime, FT.LastAccessTime, FT.LastWriteTime
        'заменяем атрибуты файла
        SetFileAttributes strNewFilePath, hFileAttr
        'закрываем дескриптор
        CloseHandle hFile
        write2file = (Err.Number + GetLastError) = 0
    End If
End Function