В массиве вычислять, контролировать на листе

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
 
Option Explicit
 
Private arr_2d() As Variant
Private ws As Worksheet
Private bDebug As Boolean
Private Row_Offset As Long, Col_Offset As Long     ' Для отслеживания на листе
 
Private Const Col_Приход As Long = 3
Private Const Col_Расход As Long = 4
Private Const Col_ФИФО As Long = 5
 
Public Sub ФИФО_Массив_Лист()
' Работать в массиве и мониторить на листе
    bDebug = False ' True
 
    Row_Offset = 3: Col_Offset = 0
 
    Set ws = ActiveWorkbook.ActiveSheet
 
    With ws
        Dim rng As Range
        Set rng = .Range(.Cells(1 + Row_Offset, 1), _
        .Cells(12 + Row_Offset, Col_ФИФО))
        .Range(.Cells(4, Col_ФИФО), .Cells(15, Col_ФИФО)).ClearContents           ''===для Отладки, потом У далить
    End With
 
    arr_2d = rng.Value
 
    Приход_и_Расход_Копировать_в_Фифо
 
    Dim y As Long
 
    For y = LBound(arr_2d) To UBound(arr_2d)
 
        If bDebug Then Лист_Монитор y, Col_Приход
 
        Приход_Найти y
    Next
 
    rng = arr_2d
 
    MsgBox "Всё !"
End Sub
 
Private Sub Приход_и_Расход_Копировать_в_Фифо()
    Dim y As Long
 
    For y = LBound(arr_2d) To UBound(arr_2d)
 
        ' Если в одной строке и приход и расход, не копирую
        If arr_2d(y, Col_Приход) * arr_2d(y, Col_Расход) = 0 Then
 
            If arr_2d(y, Col_Приход) > 0 Then
                If bDebug Then Лист_Монитор y, Col_Приход
 
                arr_2d(y, Col_ФИФО) = arr_2d(y, Col_Приход)
                If bDebug Then Лист_Монитор y, Col_ФИФО, arr_2d(y, Col_ФИФО)
            End If
 
            If arr_2d(y, Col_Расход) > 0 Then
                If bDebug Then Лист_Монитор y, Col_Расход
 
                arr_2d(y, Col_ФИФО) = arr_2d(y, Col_Расход)
                If bDebug Then Лист_Монитор y, Col_ФИФО, arr_2d(y, Col_ФИФО)
            End If
        End If
    Next
End Sub
 
Private Sub Приход_Найти(ByVal y As Long)
    Dim Приход As Double, ФИФО As Double
    Приход = arr_2d(y, Col_Приход)
    ФИФО = arr_2d(y, Col_ФИФО)
 
    If Приход > 0 And ФИФО <> 0 Then
 
        If bDebug Then Лист_Монитор y, Col_Приход
 
        Расход_найти y
 
    End If
End Sub
 
Private Sub Расход_найти(ByVal Row_Приход As Long)
    Dim Row_Расход As Long
 
    For Row_Расход = LBound(arr_2d) To UBound(arr_2d)
 
        If bDebug Then Лист_Монитор Row_Расход, Col_Расход
 
        If arr_2d(Row_Расход, Col_Приход) = 0 And _
           arr_2d(Row_Расход, Col_Расход) > 0 And _
           arr_2d(Row_Расход, Col_ФИФО) <> 0 And _
           Row_Приход < Row_Расход Then
 
            Приход_Расход_ВзаимоСократить Row_Приход, Row_Расход
            If arr_2d(Row_Приход, Col_ФИФО) = 0 Then
                Exit For    'искать непустой Приход
            End If
        End If
    Next
End Sub
 
Private Sub Приход_Расход_ВзаимоСократить(ByVal Row_Приход As Long, _
                                          ByVal Row_Расход As Long)
'для наглядности отладки ввожу псевдонимы
    Dim Приход_Был As Double, Расход_Был As Double
    Dim Приход_Стал As Double, Расход_Стал As Double
 
    Приход_Был = arr_2d(Row_Приход, Col_ФИФО)
    Расход_Был = arr_2d(Row_Расход, Col_ФИФО)
 
    If Приход_Был >= Расход_Был Then
        Приход_Стал = Приход_Был - Расход_Был
        Расход_Стал = 0
    Else
        Приход_Был = Приход_Был - Расход_Был
        Расход_Стал = Приход_Был * -1
        Приход_Стал = 0
    End If
 
    If bDebug Then Лист_Монитор Row_Приход, Col_ФИФО
    arr_2d(Row_Приход, Col_ФИФО) = Приход_Стал
    If bDebug Then Лист_Монитор Row_Приход, Col_ФИФО, Приход_Стал
 
    If bDebug Then Лист_Монитор Row_Расход, Col_ФИФО
    arr_2d(Row_Расход, Col_ФИФО) = Расход_Стал
    If bDebug Then Лист_Монитор Row_Расход, Col_ФИФО, Расход_Стал
 
End Sub
 
Private Sub Лист_Монитор(ByVal iRow As Long, _
                         ByVal iCol As Long, Optional ByVal cellValue As Variant)
 
    If IsMissing(cellValue) Then
        ' Чисто показываю
        ws.Cells(iRow + Row_Offset, iCol + Col_Offset).Select
    Else
        ' Вставляю по взрослому
        ws.Cells(iRow + Row_Offset, iCol + Col_Offset).Value = cellValue
    End If
 
    DoEvents
    Sleep 100&
End Sub