2

Я ищу способ использования команд

.удалять

.резать

В моём 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 Если кто-то тоже знает, как сократить сортировку, это тоже было бы здорово.

1 ответ1

3

В целом, самый быстрый способ передачи данных - это назначение:

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 не происходило.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .