从同一行但其他列复制值（变量偏移量）Excel VBA

Question

下面的代码确保范围 ("D16:E25") 中只有一个单元格可以包含任何值，当在该范围内的其他单元格之一中输入任何 value/string 时，该代码删除所有其他的。（这部分工作正常，感谢 "Macro Man"）

现在我想要代码从 B 列中的某个单元格复制（并粘贴到 "B5"）一个值，这需要是与列中的值位于同一行的单元格范围（"D16:E16"）。尝试了您可以在下面找到的以下代码......但它没有用。有没有人知道这个的解决方案？我更喜欢工作簿（单元格 "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

Answer 1

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

和

Application.EnableEvents = True

那么当相交为真时，您的程序将运行符合预期。

Answer 2

将 a 设置为 Range object 可能有点矫枉过正，因为您已经通过查看单个单元格目标获得了该行。

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

从同一行但其他列复制值（变量偏移量）Excel VBA

Copy value from same row but other Column (variable offset) Excel VBA

excel

vba

copy