Option Explicit
Private Enum MouseEventFlags
    MOUSEEVENTF_MOVE = 1
End Enum
Private Declare PtrSafe Sub mouse_event Lib "user32" ( _
        ByVal dwFlags As MouseEventFlags, _
        ByVal dx As Long, _
        ByVal dy As Long, _
        ByVal dwData As Long, _
        ByVal dwExtraInfo As LongPtr)

Private Const Interval As Date = #12:00:29 AM# 'интервал срабатывания тймера (29 секунд)
Private NextTime As Date
Private blAnimationOn As Boolean
'
Sub KeepingAnimation()
    If blAnimationOn Then
        'каждые 29 сек. вызывает имитацию активности пользователя (небольшое колебание указателя мыши)
        NextTime = NextTime + Interval
        Application.OnTime NextTime, "Лист1.KeepingAnimation"
        DoEvents
        mouse_event MOUSEEVENTF_MOVE, 1, 0, 0, 0
        mouse_event MOUSEEVENTF_MOVE, -1, 0, 0, 0
    End If
End Sub
'включаем таймер при активации листа
Private Sub Worksheet_Activate()
    blAnimationOn = True
    NextTime = Now + Interval
    Application.OnTime NextTime, "Лист1.KeepingAnimation"
End Sub
'отключаем таймер при деактивации листа
Private Sub Worksheet_Deactivate()
    blAnimationOn = False
End Sub

Function NumToLiter(ByVal lNum As Long) As String
    Const Base& = 26
    Dim lTmp&
    Do
        lTmp = (lNum - 1) \ Base
        NumToLiter = ChrW(lNum - lTmp * Base + 64) & NumToLiter
        lNum = lTmp
    Loop While lNum
End Function

Option Explicit
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#If Win64 Then
    Private Const ptrSz = 8
    Private Const varSz = 24
    Private Const collItemOffset = 40
#Else
    Private Const ptrSz = 4
    Private Const varSz = 16
    Private Const collItemOffset = 24
#End If
Private Const NullPtr As LongPtr = 0

Function ColKeys(Coll As VBA.Collection) As String()
    Dim i&, pItem As LongPtr, Key$, pKey As LongPtr
    Dim Ub&: Ub = Coll.Count - 1
    If Ub = -1 Then Exit Function
    Dim Keys$(): ReDim Keys(Ub)
    pKey = VarPtr(Key)
    pItem = ObjPtr(Coll)
    For i = 0 To Ub
        CopyMemory pItem, ByVal pItem + collItemOffset, ptrSz
        CopyMemory ByVal pKey, ByVal pItem + varSz, ptrSz
        Keys(i) = Key
    Next
    CopyMemory ByVal pKey, NullPtr, ptrSz
    ColKeys = Keys
End Function

Private Sub ColKeysTest()
    Dim i&, Coll As New Collection
    Dim Keys$()
    
    Coll.Add "item1", "key1"
    Coll.Add "item2", "key2"
    Coll.Add "item3", "key3"

    Keys = ColKeys(Coll)
End Sub

Private Sub Пример()
    Dim lAr&()
    lAr = Распределение(30, 60, 2, 8)
End Sub
Function Распределение(Min!, Max!, Interval!, Count!)
    Dim i!, l&, lAr(), Stp!
    ReDim lAr(1 To Count, 1 To 1)
    Stp = (Max - Min) / (Count - 1)
    For i = Min To Max Step Stp
        l = l + 1
        lAr(l, 1) = ((i - 1) \ Interval) * Interval + Interval
    Next
    Распределение = lAr
End Function

Sub ВычислениеФормул()
  Dim arInp(): arInp = Лист1.Range("D3:D12").Value
  Dim перем1#: перем1 = arInp(1, 1)
  Dim перем2#: перем2 = arInp(2, 1)
  Dim перем3#: перем3 = arInp(3, 1)
  Dim перем4#: перем4 = arInp(4, 1)
  Dim перем5#: перем5 = arInp(5, 1)
  Dim перем6#: перем6 = arInp(6, 1)
  Dim перем7#: перем7 = arInp(7, 1)
  Dim перем8#: перем8 = arInp(8, 1)
  Dim перем9#: перем9 = arInp(9, 1)
  Dim перем10#: перем10 = arInp(10, 1)
  Dim arRes()
  ReDim arRes(1 To 3, 1 To 1) 'arRes(1 To 1000000, 1 To 1)
  
  'Комментарий для первой формулы (комбинации)
  arRes(1, 1) = перем1 * перем2 * перем3
  
  'Комментарий для второй формулы
  arRes(2, 1) = перем1 * перем10 * перем9 / перем7
  
  'Комментарий для 3ей формулы
  arRes(3, 1) = перем6 + перем3 + перем9
  
  '***
  
  'Вывод результата на лист (Лист2)
  Лист2.Cells(1).Resize(UBound(arRes)).Value = arRes
End Sub