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
无法使可变循环正常工作。
电子表格的工作原理是将新数据粘贴到 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