題 宏幫助:找到Cut和Delete for Speed的替代品


我正在尋找使用命令的方法

。刪除

。切

在我的excel宏中。我發現這些過程大大減慢了程序(最多20分鐘),因為它有更多的數據來剪切粘貼和刪除。此外,這些進程似乎從宏中停用我的狀態欄更新。

如果符合某個條件,我會使用這些命令將行(第1列到第374列)的數據移動​​到不同的工作表中。

這是我使用這些命令的宏進程: 我關注的主要問題是350,353和357

328      j = 0
329      FinalRowMF = Worksheets("Main Frame").Cells(Rows.Count, 8).End(xlUp).Row
330      FinalRowAr = Worksheets("Archive").Cells(Rows.Count, 8).End(xlUp).Row

331      For k = 7 To FinalRowMF
332          Application.StatusBar = "Ignore = " & Ignore & "                    Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & "                    Loop k = " & k - 6 & " of " & FinalRowMF - 6
333          If Worksheets("Main Frame").Cells(k, 6).Value = "" Then
334              j = j + 1
335          End If
336      Next k
337      Worksheets("Archive").Activate
338      If j = 0 Then
339      Worksheets("Archive").Range(Cells(7, 9 + DaysOffset), Cells(FinalRowAr, 9 + DaysOffset)).Interior.ThemeColor = xlThemeColorAccent4
    GoTo NoInactives:
340      End If
341      ActiveWindow.ScrollColumn = DaysOffset
342      Worksheets("Archive").ListObjects("Table24").Resize Range("$F$6:NJ" & FinalRowAr + j)
343      With Worksheets("Archive").Range("$I$" & FinalRowAr + 1 & ":NJ" & FinalRowAr + j).Interior
344                                                                                      .Pattern = xlNone
345                                                                                      .TintAndShade = 0
346                                                                                      .PatternTintAndShade = 0
347      End With

348      m = j
349      For n = 7 To FinalRowMF - j
350      Application.StatusBar = "Ignore = " & Ignore & "                    Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & "          Finding and Moving ID " & j - m + 1 & " of " & j & "                    Loop n = " & n - 6 & " of " & FinalRowMF - 6
351          If Worksheets("Main Frame").Cells(n, 6).Value = "" Then
352              FinalRowAr = Worksheets("Archive").Cells(Rows.Count, 8).End(xlUp).Row
353              Worksheets("Main Frame").Rows(n).Cut Destination:=Worksheets("Archive").Range(Cells(FinalRowAr + 1 - m, 1), Cells(FinalRowAr + 1 - m, 374))
354              Worksheets("Archive").Range(Cells(FinalRowAr + 1 - m, 1), Cells(FinalRowAr + 1 - m, 374)).Borders(xlEdgeTop).LineStyle = xlNone
355              Worksheets("Archive").Cells(FinalRowAr + 1 - m, 8).Borders(xlEdgeTop).ThemeColor = 1
356              Worksheets("Archive").Cells(FinalRowAr + 1 - m, 8).Borders(xlEdgeTop).TintAndShade = -0.249977111117893
357              Worksheets("Main Frame").Rows(n).Delete Shift:=xlUp
358              If m = 0 Then
359              Else
360              n = n - 1
361              m = m - 1
362              End If
363          End If
        If m = 0 Then GoTo LastReplaced:
364      Next n

LastReplaced:

365      Application.StatusBar = "Ignore = " & Ignore & "                    Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & "                    Loop k Counter Result j = " & j
366      Worksheets("Archive").Range(Cells(7, 9 + DaysOffset + 1), Cells(FinalRowAr, 9 + DaysOffset + 1)).Interior.ThemeColor = xlThemeColorAccent4
367      ArDateChange = ImportDate - 1
368      ArSort = True
    GoTo SetMonth:

ArSort:

369      With ActiveWorkbook.Worksheets("Archive").ListObjects("Table24").Sort
370              .SortFields.Clear
371              .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, xlSortNormal).SortOnValue.ColorIndex = xlNone
372                  .Header = xlYes
373                  .MatchCase = False
374                  .Orientation = xlTopToBottom
375                  .SortMethod = xlPinYin
376                  .Apply
377              .SortFields.Clear
378              .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 65535
379                  .Header = xlYes
380                  .MatchCase = False
381                  .Orientation = xlTopToBottom
382                  .SortMethod = xlPinYin
383              .SortFields.Clear
384              .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 49407
385                  .Header = xlYes
386                  .MatchCase = False
387                  .Orientation = xlTopToBottom
388                  .SortMethod = xlPinYin
389                  .Apply
390              .SortFields.Clear
391              .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 230
392                  .Header = xlYes
393                  .MatchCase = False
394                  .Orientation = xlTopToBottom
395                  .SortMethod = xlPinYin
396                  .Apply
397              .SortFields.Clear
398              .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 16711935
399                  .Header = xlYes
400                  .MatchCase = False
401                  .Orientation = xlTopToBottom
402                  .SortMethod = xlPinYin
403                  .Apply
404              .SortFields.Clear
405      End With

NoInactives:

PS如果有人也知道如何縮短排序,那也很棒。


2
2017-07-20 22:17


起源




答案:


一般來說,傳輸數據的最快方法是通過分配:

Sheets("Sheet2").Range("A1:C10").Formula =  
  Sheets("Sheet1").Range("A1:C10").Formula
Sheets("Sheet2").Range("A1:C10").Interior.Color =  
  Sheets("Sheet1").Range("A1:C10").Interior.Color

請注意,如果要分配公式,則無需指定值。

我不明白你是怎麼離開的 .delete

最後,重構電子表格可能更簡單 .delete 不需要發生。


3
2017-07-20 22:53



查看第353行的.cut參考。您的建議只會復制正確的值嗎?我需要復制公式和單元格填充顏色 - B-Ballerl
@ B-B,好吧,我現在看到它(希望搜索在編輯框中工作得很好)。您還可以使用相同的Range對象(只是不同的屬性)直接分配公式和單元格填充顏色。我會嘗試一下,看看它是否加快了速度。可能(我認為).cut是真正的問題。回答編輯。 - Lance Roberts