VBA 运行 工作表更改事件期间的可变循环

VBA Running a Variable Loop during a Worksheet Change Event

无法使可变循环正常工作。

电子表格的工作原理是将新数据粘贴到 A 列到 H 列的下一个空白行中,每次的行数都是可变的。

当 A 列中的目标行 <> 0 并且信息是从粘贴的数据中推断出来并显示在 J 到 N 列中时,会发生更改事件。但是此代码仅适用于新数据的第一行。我相信它需要一个循环,但我不确定如何让它工作?

我试图在网上找到一个很好的例子,但我每次尝试都在挣扎和失败。非常感谢任何可以帮助我或为我指明正确方向的人!

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo enditall
If Target.Cells.Column = 1 Then

    n = Target.row
    arange = Range("A" & n)
    brange = Range("B" & n)
    crange = Range("C" & n)
    drange = Range("D" & n)
    erange = Range("E" & n)
    frange = Range("F" & n)
    grange = Range("G" & n)
    hrange = Range("H" & n)

    Dim myRange As Excel.Range
    Dim myCell As Excel.Range
    Set myRange = Target

Application.EnableEvents = False

For Each myCell In myRange.Cells
If Excel.Range("A" & n).Value <> "" Then
    Excel.Range("J" & n) = DateValue(Left(hrange, 10))
    Excel.Range("k" & n) = Left(brange, 3)
    Excel.Range("L" & n) = Mid(brange, 5, 2)
    Excel.Range("M" & n) = Left(drange, 1)
    If Excel.Range("M" & n) = "B" Then Excel.Range("N" & n) = erange
    If Excel.Range("M" & n) = "S" Then Excel.Range("N" & n) = erange * -1
End If
Next

End If

全部结束:

Application.EnableEvents = True

结束子

试试这个:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim rw As Range

    If Application.Intersect(Target, Me.Columns(1)) Is Nothing Then Exit Sub

    'On Error GoTo enditall

    Application.EnableEvents = False

    For Each rw In Target.Rows

        If rw.Cells(1, "A").Value <> "" Then
            rw.Cells(1, "J") = DateValue(Left(rw.Cells(1, "H"), 10))
            rw.Cells(1, "k") = Left(rw.Cells(1, "B"), 3)
            rw.Cells(1, "L") = Mid(rw.Cells(1, "B"), 5, 2)
            rw.Cells(1, "M") = Left(rw.Cells(1, "D"), 1)
            If rw.Cells(1, "M") = "B" Then rw.Cells(1, "N") = rw.Cells(1, "E")
            If rw.Cells(1, "M") = "S" Then rw.Cells(1, "N") = rw.Cells(1, "E") * -1
        End If

    Next rw

enditall:

    Application.EnableEvents = True
End Sub