Question

一般来说，我的宏遍历每一个＆＃34; O＆＃34;单元格，检查行是否满足给定的要求（在此部分代码中未提及）并复制周围的单元格。我在这部分中使用了两列：＆＃34;合同号＃34;（M），＆＃34;日期＆＃34;（O）。问题是我尝试使用下面的方法来持续合同号并复制它。我没有收到任何错误，但合同单元格值没有粘贴。你能告诉我我做错了吗？

If ActiveCell.Offset(0, -2) = "" Then
    'Go up find contract number copy
    ActiveCell.Offset(0, -2).Select
    Do Until ActiveCell.Value <> ""
        ActiveCell.Offset(-1, 0).Select                                                                     
    Loop                                                     
    ActiveSheet.Range("M" & ActiveCell.Row).Copy _
        Destination:=ActiveSheet.Range("V" & ActiveCell.Row)
    'Go down and return to the last active cell
    Do Until ActiveCell.Value <> ""
        ActiveCell.Offset(1, 0).Select 
    Loop
    ActiveCell.Offset(0, 2).Select
End If

Answer 1

您没有选择所需的单元格

问题在于这个循环：

'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do Until ActiveCell.Value <> ""
    'Selecting cell from previous row in the same column
    ActiveCell.Offset(-1, 0).Select
Loop

您可以在.Select单元格之前离开循环。

请改用此循环：

'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do
    'Selecting cell from previous row in the same column
    ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell.Value <> ""

Answer 2

尽量不要使用ActiveCell如果选择了错误的单元格，您的代码可能会对您的工作表做出非常不可预测的事情，我的改进也可以＃34;以下。

Sub FindAndCopy()

    Dim Ws As Worksheet
    Dim R As Long, C As Long

    With ActiveCell
        Set Ws = .Worksheet
        R = .Row
        C = .Column
    End With

    With Ws
        If Len(Trim(.Cells(R, C - 2).Value)) = 0 Then
            'Go up find contract number copy
            Do Until Len(.Cells(R, C - 2).Value)
                R = R - 1
            Loop
            .Cells(R, "M").Copy Destination:=.Cells(ActiveCell.Row, "V")
        End If
    End With
End Sub

我认为此代码中的ActiveCell组件仍然是一个非常危险的来源。但是，正如您所看到的，至少代码并没有改变它，这最终无需返回它。

Answer 3

问题在于你在

之后依赖ActiveCell

ActiveCell.Offset(-1, 0).Select

声明，改变它......

当您使用ActiveCell和Select / Selection编码模式时，您实际上正在玩火！

因为我无法看到您展示的代码背后的内容，所以我必须继续使用ActiveCell引用并根据评论修改您的代码：

Dim cellToCopy As Range
With ActiveCell 'reference currently "active" cell
    If .Offset(0, -2) = "" Then 'if the cell two columns left of referenced (i.e. "active") cell is empty...
        Set cellToCopy = .Offset(0, -2).End(xlUp) '... set cell to copy as the first not empty one above the cell two columns left of referenced (i.e. "active") cell
    Else '... otherwise
        Set cellToCopy = .Offset(0, -2) 'set cell to copy as the one two columns left of referenced (i.e. "active") cell
    End If
    cellToCopy.Copy Destination:=Range("V" & .Row) 'copy the cell set as the one to be copied and paste it column V cell same row as reference (i.e. "active") cell
End With

循环播放复制细胞

3 个答案:

您没有选择所需的单元格