Question

有人知道如何将其从2更改为1。我的意思是前4行，因此它与上面代码中的if语句匹配，并且对所有数据都有效。我从另一个问题的答案中修改了代码。我了解我修改的答案代码，但是现在我陷入了困境，不知道该怎么做。我尝试过i=i+1，但它会覆盖值。

Sub testo()

    Const cSheet As String = "Procenty"   
    Const cRange As String = "A2:D73"     
    Const cel As Long = 4             
    Const cCol As Variant = "A"           

    Dim vntS As Variant   
    Dim vntT As Variant   
    Dim i As Integer     
    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)

    ReDim vntT(1 To UBound(vntS), 1 To cel)

    kredyt = 0
    For i = 1 To UBound(vntS)
        If vntS(i, 1) = "" Then
            dw = Date
        Else
            dz = vntS(i, 1)
        End If

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

        If kom = komz Then

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

        ElseIf komz > kom Then
            komr = komz - kom
            vntT(i, 1) = dz
            vntT(i, 2) = komz
            vntT(i, 3) = dw
            vntT(i, 4) = kom
            vntT(i + 1, 1) = dz
            vntT(i + 1, 2) = komr
            vntT(i + 1, 3) = dw
            vntT(i + 1, 4) = kom

        ElseIf komz < kom Then
            komn = kom - komz
            vntT(i, 1) = dz
            vntT(i, 2) = komz
            vntT(i, 3) = dw
            vntT(i, 4) = kom
            vntT(i + 1, 3) = dw
            vntT(i + 1, 4) = komn

        End If

    Next

    With ThisWorkbook.Worksheets(cSheet)

        emptyRow = .Columns(cCol).Find("*", , xlFormulas, _
        xlWhole, xlByColumns, xlPrevious).Row + 1
'emptyRow = WorksheetFunction.CountA(.Columns(cCol)) + 1
' wypisywanie tablicy
        .Cells(emptyRow, cCol).Resize(UBound(vntT), UBound(vntT, 2)) = vntT
        .Cells(emptyRow, cCol) = kredyt
    End With
End Sub

Answer 1

这是我最好的猜测...

Sub testo()

    Const cSheet As String = "Procenty"
    Const cRange As String = "A2:D73"
    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 2 * UBound(vntS), 1 To cel) '<< add space for extra rows

    kredyt = 0
    r = 1 '<< "row" counter for vntT
    For i = 1 To UBound(vntS)

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

        vntT(r, 1) = dz
        vntT(r, 2) = komz
        vntT(r, 3) = dw
        vntT(r, 4) = kom
        r = r + 1

        If komz > kom Then
            komr = komz - kom
            vntT(r, 1) = dz
            vntT(r, 2) = komr
            vntT(r, 3) = dw
            vntT(r, 4) = kom
            r = r + 1
        ElseIf komz < kom Then
            komn = kom - komz
            vntT(r, 3) = dw
            vntT(r, 4) = komn
            r = r + 1
        End If
    Next

    'etc...

End Sub

Excel VBA表：有人知道该怎么做吗？

1 个答案: