改变范围rest小组

我需要closures设置第一行,所以我改变了范围从Sub

For Each rng In Sheets("360").Range("B:CJ" & Lastrow) 

 For Each rng In Sheets("360").Range("B2:CJ2" & Lastrow) 

小知识大麦运行花了5秒跑,知道如果它甚至完成需要几分钟

如何解决这个问题?

谢谢

 Sub CleanAll() Dim rng As Range Dim Lastrow As Long With Sheets("360") Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row End With For Each rng In Sheets("360").Range("B2:CJ" & Lastrow) rng.Value = NumberOnly(rng.Value) Next End Sub 

function

 Function NumberOnly(strSource As String) As String Dim i As Integer Dim strResult As String For i = 1 To Len(strSource) Select Case Asc(Mid(strSource, i, 1)) Case 32, 48 To 57, 65, 78: strResult = strResult & Mid(strSource, i, 1) End Select Next NumberOnly = strResult End Function 

 For Each rng In Sheets("360").Range("B2:CJ2" & Lastrow) 

删除以下2个CJ像这样:

 For Each rng In Sheets("360").Range("B2:CJ" & Lastrow) 

Lastrow已经指定了最后一个行号,所以如果Lastrow的值是300,并且你写了“CJ2”&Lastrow,那么你的实际范围现在是B2:CJ2300,这意味着你现在正在运行2000多行。

我发现在表格中使用你的数据将解决大量的重新调整范围问题。

话虽如此,你应该从你的范围创build一个变体数组,然后通过variables数组循环。 一旦完成复制到arrays回到范围。 这会加快一百倍。

像这样的东西…

 Sub CleanAll() Dim myArray As Variant Dim Lastrow As Long With Sheets("360") Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row End With myArray = Sheets("360").Range("B2:CJ" & Lastrow) For x = LBound(myArray) To UBound(myArray) For y = LBound(myArray, 2) To UBound(myArray, 2) myArray(x, y) = NumberOnly(myArray(x, y)) Next y Next x Sheets("360").Range("B2:CJ" & Lastrow) = myArray End Sub Function NumberOnly(ByVal strSource As String) As String Dim i As Integer Dim strResult As String For i = 1 To Len(strSource) Select Case Asc(Mid(strSource, i, 1)) Case 32, 48 To 57, 65, 78: strResult = strResult & Mid(strSource, i, 1) End Select Next NumberOnly = strResult End Function