Question

我正在创建一个Excel电子表格。我有两个独立的功能，我需要结合，但我不知道如何将它们粉碎在一起。我知道我只能有一个改变事件。第一个函数将取消保护工作表（列c被锁定），当数据输入A列时自动填充C列，或者当A被擦除时擦除C并在完成时重新保护。当数据输入A和B时，第二行将单元格焦点返回到下一行A列。另外，它们根据需要工作。

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Unprotect Password:="my password"
    If Target.Column = 1 Then
        Dim A As Range, B As Range, Inte As Range, r As Range
       Set A = Range("A:A")
       Set Inte = Intersect(A, Target)
    If Target.Offset(0, 1 - Target.Column).Value = "" Then
        Target.Offset(0, 3 - Target.Column).Clear
        Exit Sub
    End If
    Application.EnableEvents = False
    For Each r In Inte
    r.Offset(0, 2).Value = Date & " " & Time
    r.Offset(0, 2).NumberFormat = "m/d/yyyy h:mm am/pm"
    Next r
    Application.EnableEvents = True       
    End If
    Protect Password:="my password"
    End Sub


    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa
    Application.EnableEvents = False
    If Not Target.Cells.CountLarge > 1 Then
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Target.Offset(, 1).Select
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        Target.Offset(1, -1).Select
    End If
    End If
    Letscontinue:
    Application.EnableEvents = True
    Exit Sub
    Whoa:
    MsgBox Err.Description
    Resume Letscontinue
    End Sub

Answer 1

这个怎么样，似乎做了你想要的，因为我理解这个问题。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngIntersect    As Range
    Dim rngCell         As Range

    On Error GoTo TidyUp

    Application.EnableEvents = False

    If Target.Column = 1 Then

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

        For Each rngCell In rngIntersect
            If rngCell.Value = "" Then
                rngCell.Offset(0, 2).Value = ""
            Else
                rngCell.Offset(0, 2).Value = Date & " " & Time
                rngCell.Offset(0, 2).NumberFormat = "m/d/yyyy h:mm am/pm"
            End If
        Next rngCell
    End If

    If Target.Column < 3 And Target.Value <> "" Then  ' lose the 'And Target.Value <> ""' as desired
        Cells(Target.Row + Target.Rows.Count, 1).Select
    End If

TidyUp:

    Set rngIntersect = Nothing
    Set rngCell = Nothing

    Application.EnableEvents = True

End Sub

我还建议在您的工作表中使用UserInterfaceOnly.Protect，然后您不必取消保护工作表以使VBA在工作表上操作。

Answer 2

在模块上的两个子程序中实现它，然后在Event-Procedure中调用它们。

将2“Private Sub Worksheet_Change（ByVal Target As Range）”合并为1

2 个答案: