Блог

Я пытался написать этот макрос в течение длительного времени, и я все еще постоянно борюсь с этим (на самом деле, в разных категориях), и теперь этот макрос как бы опускает мои данные.

Вот код (комментарии используются для описания того, что есть что для меня):

 Sub testro()
    Const cSheet As String = "Procenty"
    Const cRange As String = "A2:D71"
    Const cel As Long = 4
    Const cCol As Variant = "A"


    Dim vntS As Variant
    Dim vntT As Variant
    Dim i As Long, r As Long
    Dim emptyRow As Long

    Dim kom As Double, komz As Double, kredyt As Double
    Dim roz As Double, komr As Double, komn As Double
    Dim dz As Date, dw As Date

    vntS = ThisWorkbook.Worksheets(cSheet).Range(cRange).Value
    ReDim vntT(1 To 3 * UBound(vntS), 1 To cel   1)
    kredyt = 0

    r = 1

    For i = 1 To UBound(vntS)

        dz = vntS(i, 1) 
        komz = vntS(i, 2)
        dw = vntS(i, 3)
        kom = vntS(i, 4)

        If komz > kom Then

            If CStr(vntT(r, 1)) = "" Then
               vntT(r, 1) = dz
               vntT(r, 2) = komz 'debt
            End If

            vntT(r, 3) = dw
            vntT(r, 4) = kom 'payment
            vntT(r, 5) = " komz>kom"

            r = r   1

            komz = komz - kom

            vntT(r, 1) = dz
            vntT(r, 2) = komz ' Debt
            vntT(r, 3) = dw
            vntT(r, 4) = kom  '  payment
            vntT(r, 5) = " .. komz > kom"

        ElseIf komz < kom Then

            komn = kom - komz

            vntT(r, 1) = dz
            vntT(r, 2) = komz
            vntT(r, 3) = dw
            vntT(r, 4) = kom
            vntT(r, 5) = " .. A"

            r = r   1

            vntT(r, 3) = dw
            vntT(r, 4) = komn  ' Overpaid
            vntT(r, 5) = " .. komz < kom"

            r = r   1

        ElseIf komz = kom Then
            vntT(r, 1) = dz
            vntT(r, 2) = komz  ' debt
            vntT(r, 3) = dw
            vntT(r, 4) = kom   ' payment
            vntT(r, 5) = " .. komz = kom"

            r = r   1

        End If


    Next

    With ThisWorkbook.Worksheets(cSheet)
        emptyRow = .Columns(cCol).Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious).Row   1
        .Cells(emptyRow, cCol).Resize(UBound(vntT), UBound(vntT, 2)) = vntT
        .Cells(emptyRow, cCol) = kredyt
    End With
End Sub
  

Здесь я публикую скриншоты данных перед использованием макроса:

и после:

Вот ссылка на мой Google Диск со всеми скриншотами, включая тот, на котором указано, что должен делать этот макрос (с пометкой good). ссылка.

Красный цвет предназначен для данных, которые опущены (столбцы слева) и те, которые должны быть назначены им (в той же строке).

В разделе синего цвета на хорошем скриншоте вы можете увидеть, как это должно быть сделано.