复制同一行但另一列的值（可变偏移量）Excel VBA

下面的代码确保该范围（“D16:E25”）中只有一个单元格可以包含任何值，当在该范围内的另一个单元格中输入任何值/字符串时，该代码将删除所有其他单元格。（由于“宏人”，此部分工作正常）

现在我想让代码从B列中的某个单元格复制（并粘贴到“B5”）一个值，这需要是与范围（“D16:E16”）中的值位于同一行的单元格。 已尝试以下代码，您可以在下面找到。。。但它不起作用。 annyone知道这个问题的解决方案吗？ 我更喜欢工作簿（单元格“B5”）自动更新，这样就不必运行宏或按按钮

If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
    If Target.Cells.Count > 1 Then
        MsgBox "Please edit one cell at a time!"
    Else
        Application.EnableEvents = False

        newVal = Target.Value
        Range("D16:E25").ClearContents
        Target.Value = newVal
        a = ActiveCell

        Application.EnableEvents = True
    End If
End If

If a.Column = 4 Then
    Range("B5") = Range(a).Offset(0, -2).Value
        Else: Range("B5") = Range(a).Offset(0, -3).Value
End If

End Sub

这里有三个问题： 首先，如果将a设置为范围，那么正确的方法是

Set a = ActiveCell

其次，如果将a设置为范围，则在第二个if函数中调用它的正确方法是

If a.Column = 4 Then
    Range("B5") = a.Offset(0, -2).Value
       Else: Range("B5") = a.Offset(0, -3).Value
End If

而不是

If a.Column = 4 Then
    Range("B5") = Range(a).Offset(0, -2).Value
       Else: Range("B5") = Range(a).Offset(0, -3).Value
End If

第三，上面的if函数应该放在

Set a = ActiveCell

及

当intersect为真时，您的程序将按预期运行。

3问题如下： 首先，如果将a设置为范围，那么正确的方法是

Set a = ActiveCell

其次，如果将a设置为范围，则在第二个if函数中调用它的正确方法是

If a.Column = 4 Then
    Range("B5") = a.Offset(0, -2).Value
       Else: Range("B5") = a.Offset(0, -3).Value
End If

而不是

If a.Column = 4 Then
    Range("B5") = Range(a).Offset(0, -2).Value
       Else: Range("B5") = Range(a).Offset(0, -3).Value
End If

第三，上面的if函数应该放在

Set a = ActiveCell

及

---

当intersect为真时，您的程序将按预期运行。

将

a设置为a可能有点过分，因为通过查看单个单元格目标，您已经拥有了行

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        If Intersect(Target, Range("D16:E25")).Cells.Count > 1 Then
            Application.Undo
            MsgBox "Please edit one cell at a time!"
        Else
            Dim newVal As Variant

            newVal = Target.Value
            Range("D16:E25").ClearContents
            Target.Value = newVal
            Cells(5, 2) = Cells(Target.Row, 2).Value

        End If
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

将
a
设置为a可能有点过分，因为通过查看单个单元格目标，您已经拥有了行

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        If Intersect(Target, Range("D16:E25")).Cells.Count > 1 Then
            Application.Undo
            MsgBox "Please edit one cell at a time!"
        Else
            Dim newVal As Variant

            newVal = Target.Value
            Range("D16:E25").ClearContents
            Target.Value = newVal
            Cells(5, 2) = Cells(Target.Row, 2).Value

        End If
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

为什么您告诫使用MsgBox进行多单元格编辑，但不反转过程（从而允许多单元格编辑保留）？为什么您告诫使用MsgBox进行多单元格编辑，但不反转过程（从而允许多单元格编辑保留）？如果
a
确实是a，那么它应该是设置的，而不是简单地分配的。。但是“a.column”的使用使得它看起来像是一个范围，而不是一个字符串。你注意到还有另外两个问题。thx指出如果
a
确实是a，那么它应该是
Set
，而不是简单地赋值。yea同意。。但是使用“a.column”似乎是为了让它成为一个范围而不是一个字符串。你注意到还有另外两个问题。谢谢你指出这一点。注意，我包括了对
应用程序的调用。Undo
可反转D16:E25范围内的多个单元格编辑。很高兴您能这样做。请注意，我包含了对
Application.Undo
的调用，以反转D16:E25范围内的多个单元格编辑。