Question

由于某些原因，在单元格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

Answer 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

Answer 2

正如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

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

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

2 个答案: