Question

下面的代码将A的内容添加到B，然后在整个列中清除A。如何复制此函数，以使多个列在同一子对象中具有自己的目标？我必须为每个人写一个私人的小礼物吗？

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim T As Range, r As Range

    Set T = Intersect(Target, Range("A:A"))

    If T Is Nothing Then Exit Sub

    Application.EnableEvents = False

    For Each r In T

        With r
            .Offset(0, 1).Value = .Offset(0, 1).Value + .Value
            .ClearContents

        End With

    Next r

    Application.EnableEvents = True

End Sub

谢谢！

Answer 1

单列：

尝试将Select Case与Target.Column一起使用，以根据具有事件的列确定要执行的操作。在@AJD的有用评论之后，添加一个GetLastRow函数，以确保仅循环填充的列范围。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Columns.Count <> 1 Then Exit Sub
    Select Case Target.Column
    Case 1
        'col A do something
        ClearRange Target
    Case 2
        'col B do something
        ClearRange Target
        'Etc
    End Select
    Application.EnableEvents = True
End Sub

Public Sub ClearRange(ByVal T As Range)          '<== This works on the basis Target is a single column
    Dim r As Range, loopRange As Range, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(T.Parent.Name)
    Set loopRange = ws.Range(ws.Cells(1, T.Column), ws.Cells(GetLastRow(ws, T.Column), T.Column))
    If loopRange Is Nothing Then Exit Sub
    'Debug.Print loopRange.Address
    For Each r In loopRange
        With r
            .Offset(0, 1).Value = .Offset(0, 1).Value + .Value
            .ClearContents
        End With
    Next r
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

tl; dr;

多列：

您可以按照以下方式重新编写您的密码。虽然我不确定多列会发生什么。说，最简单的情况是A：B列是Target，A是否循环传输并添加到B，A是否被清除，B被循环，添加到C，B是否被清除？我不太清楚，所以没有为内部写任何东西。我只是谈到了如何添加更多目标的标题。很高兴在澄清后更新。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False

    If Not Intersect(Target, Range("A:A")) Is Nothing Then

    End If

    If Not Intersect(Target, Range("B:B")) Is Nothing Then

    End If

    Application.EnableEvents = True
End Sub

如何在此代码中添加多个目标？

1 个答案: