Copy and Repeat Code Breaks After Row 488

2019-09-09 11:14发布

For some reason after cell 488 the function stops copying correctly. After 488 all the way to the end (about row 1,000) it pulls from the same cell all the way to the bottom.

Any way to make this code more robust so that it will always pull from the cell in the same row?

If I need to clarify please let me know, i would be happy to elaborate however necessary.

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条回答
Animai°情兽
2楼-- · 2019-09-09 11:54

You are converting to value before calculation completed.

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
查看更多
走好不送
3楼-- · 2019-09-09 11:55

As cyboashu stated you are converting before calculation is completed which is causing the problem.

However you are first placing the Formula to the Cell and then copying the Value into the Cell. This can be shortened to letting VBA calculate the Value and place it into the 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

The functionality of the above code is tested and works.

查看更多
登录 后发表回答