从同一行复制值,但从其他列(可变偏移)Excel VBA复制

时间:2015-10-27 12:01:28

标签: excel vba excel-vba copy

下面的代码确保范围中只有一个单元格(“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

2 个答案:

答案 0 :(得分:2)

这里有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

然后当相交为真时,程序将按预期运行。

答案 1 :(得分: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