在行488之后复制并重复代码中断

时间:2016-08-02 21:45:42

标签: vba excel-vba excel

由于某些原因,在单元格488之后,该功能会正确地停止复制。在488之后一直到最后(约1000行),它从同一个单元一直拉到底部。

是否有任何方法可以使这段代码更加健壮,以便始终从同一行的单元格中拉出来?

如果我需要澄清请告诉我,我很乐意详细说明。

Sub Compare()
    Dim lastRow As Long

    With Sheets("MP Parameters")
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).row
        Range("A1").EntireColumn.Insert
        With .Range("A5:A" & lastRow)
            .Formula = "=MID(B5,FIND(""¬"",SUBSTITUTE(B5,""-"",""¬"",3))+1,LEN(B5))"
            .Value = .Value
        End With
    End With
End Sub

2 个答案:

答案 0 :(得分:1)

您在计算完成前转换为值。

Sub Compare()
    Dim lastRow As Long

    With Sheets("MP Parameters")
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Range("A1").EntireColumn.Insert
        With .Range("A5:A" & lastRow)
            .Formula = "=MID(B5,FIND(""¬"",SUBSTITUTE(B5,""-"",""¬"",3))+1,LEN(B5))"

            '/ Force calculation before cobnversting to value
            Sheets("MP Parameters").Calculate
            Do
            Loop Until Application.CalculationState = xlDone

            .Value = .Value
        End With
    End With
End Sub

答案 1 :(得分:1)

正如cyboashu所说,你在计算完成之前正在转换,这导致了问题。

但是,您首先将Formula置于Cell,然后将Value复制到Cell。这可以缩短为让VBA计算Value并将其放入Cell

Sub Compare()
    Dim lastRow As Long
    Dim cell As Range

    With Worksheets("MP Parameters")
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Range("A1").EntireColumn.Insert
        For Each cell In .Range("A5:A" & lastRow)
            cell.Value = Mid(cell.Offset(0, 1), Application.WorksheetFunction.Find _
                         ("¬", Application.WorksheetFunction.Substitute(cell.Offset _
                         (0, 1), "-", "¬", 3)) + 1, Len(cell.Offset(0, 1)))
        Next
    End With
End Sub

上述代码的功能已经过测试并且有效。