在第488行之后复制并重复代码中断 [英] Copy and Repeat Code Breaks After Row 488

问题描述

由于某些原因，在单元488之后，该功能停止正确复制.在488一直到末尾(大约1000行)之后，它从同一单元格一直拉到底部.

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

推荐答案

正如cyboashu所说，您正在转换之前要完成计算，这会引起问题.

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

但是，您首先要将 Formula 放置到 Cell 中，然后将 Value 复制到 Cell 中.可以简化为让VBA计算 Value 并将其放入 Cell .

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.

这篇关于在第488行之后复制并重复代码中断的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！