由于某些原因,在单元格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
答案 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
上述代码的功能已经过测试并且有效。