Проблема с массивом Excel vba, что я могу с ним сделать, чтобы он работал?

Question

Public Function procent(fv As Double, time As Double) As Double

    procent = fv* (0.1 / 365) * time'time= diffrence between 2 dates from specific cells , fv= numeric value from cell

End Function


 Sub testo()
        Dim i As Integer, n As Integer
        Dim emptyrow As Long
        Dim kom As Double, komz As Double, dw As Double, roz As Double, komr As Double, komn As Double
        Dim napis As String
        Dim dz As Date

        'Make Sheet1 active
        Sheets("procenty").Select
        'Determine emptyRow
        emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1

        dz = Range("A1:A70").Value
        komz = Range("B1: B70").Value
        kom = Range("D1:D70").Value
        dw = Range("C1:C70").Value

        For Each Row In Range("A1:D70")
            komr = komz - kom
            roz = Abs(dz - dw)
            komn = kom - komz

            If kom = komz And dw > dz Then

                Cells(emptyrow, 1).Value = procent(kom, roz)
                Cells(emptyrow, 2).Value = procent(kom, roz) + kom

            ElseIf komz = kom And dw = dz And dz > dw Then

                Cells(emptyrow, 1).Value = napis
                Cells(emptyrow, 2).Value = napis

            ElseIf komz > kom And dz < dw Then

                Cells(emptyrow, 1).Value = procent(kom, roz)
                Cells(emptyrow, 2).Value = procent(kom, roz) + kom
                Cells(emptyrow, 3).Value = komr
                Cells(emptyrow, 4).Value = procent(komr, roz)
                Cells(emptyrow, 5).Value = procent(komr, roz) + komr

            ElseIf komz > kom And dz > dw Then
                Cells(emptyrow, 1).Value = komr

            ElseIf komz < kom Then
                Cells(emptyrow, 1).Value = komn
                Exit For
            End If
        Next Row
    End Sub

вся эта подпрограмма должна получить данные из этого выбранного диапазона и затем выполнить некоторые операции с ним в цикле, такие как умножение, сложение, различие, деление на другие конкретные ячейки, такие как этот A1 * C1, затем A2 * C2, затем проверьте,условия, при которых все хорошо, и делать то, что внутри, если и так до тех пор, пока не будут выполнены все ячейки. Вся проблема в том, что здесь я получаю много ошибок, таких как несоответствие типов, несоответствие аргументов ref, а также когда я использую своисобственная функция, с которой она ничего не делает.

Answer 1

Loop Through Array вместо Range

• Это должно работать, если функции procent и "Do your thing" верны.
• Exit for выглядит довольно подозрительно.
• НЕ проверено.

Код

Option Explicit

Sub testo()

    Const cSheet As String = "Procenty"   ' Source Worksheet Name
    Const cRange As String = "A1:D70"     ' Source Range Address
    Const cTarget As Long = 5             ' Target Number of Columns
    Const cCol As Variant = "A"           ' Last-Row Column

    Dim vntS As Variant   ' Source Array
    Dim vntT As Variant   ' Target Array
    Dim i As Integer      ' Source/Target Array Row Counter
    Dim emptyRow As Long  ' First Empty Row

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

    ' Write Source Range to Source Array.
    vntS = ThisWorkbook.Worksheets(cSheet).Range(cRange)

    ' Resize Target Array to rows of Source Array and columns of Target
    ' Number of Columns.
    ReDim vntT(1 To UBound(vntS), 1 To cTarget)

    ' In Source Array
    For i = 1 To UBound(vntS)

        ' Write values of current row to variables.
        dz = vntS(i, 1)
        komz = vntS(i, 2)
        dw = vntS(i, 3)
        kom = vntS(i, 4)

        '*******************************
        ' Start of "Do your thing".
        '*******************************

        komr = komz - kom
        roz = Abs(dz - dw)
        komn = kom - komz

        If kom = komz And dw > dz Then

            vntT(i, 1) = procent(kom, roz)
            vntT(i, 2) = procent(kom, roz) + kom

        ElseIf komz = kom And dz >= dw Then

            vntT(i, 1) = napis
            vntT(i, 2) = napis

        ElseIf komz > kom And dz < dw Then

            vntT(i, 1) = procent(kom, roz)
            vntT(i, 2) = procent(kom, roz) + kom
            vntT(i, 3) = komr
            vntT(i, 4) = procent(komr, roz)
            vntT(i, 5) = procent(komr, roz) + komr

        ElseIf komz > kom And dz > dw Then
            vntT(i, 1) = komr

        ElseIf komz < kom Then
            vntT(i, 1) = komn
            Exit For
        End If

        '*******************************
        ' End of "Do your thing".
        '*******************************

    Next

    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSheet)
        ' Determine emptyRow (Should be more reliable this way.).
        emptyRow = .Columns(cCol).Find("*", , xlFormulas,  _
                xlWhole, xlByColumns, xlPrevious).Row + 1
        'emptyRow = WorksheetFunction.CountA(.Columns(cCol)) + 1
        ' Write Target Array to Target Range.
        .Cells(emptyRow, cCol).Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub