Question

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

现在我希望代码复制（并粘贴到“B5”）来自B列中某个单元格的值，这需要是与该范围内的值在同一行中的单元格（“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

Answer 1

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

Set a = ActiveCell

其次，如果a被设置为Range，则在第二个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复制

2 个答案: