Обратные ряды диапазона - PullRequest
1 голос
/ 11 марта 2019

Я должен обратить ряды диапазона.Код, который я написал, восстанавливает диапазон 1000 строк x 1000 столбцов за 2 минуты, 18 секунд, 587 мс.Может ли кто-нибудь предоставить более быстрый код?

Среднее время 1000 строк x 1000 столбцов: 2 минуты, 18 с, 587 мс

(Intel i7-6700 4 ГГц, 32 ГБ ОЗУ) (Windows 10Домашняя x64) (Excel Office 365 MSO (16.0.11328.20144) 32 бита)

Мне не нужно отключать вычисления, ячейки не имеют формул.Код GMalc короткий и очень быстрый: 8 с, 23 мс, но предложение @Rory быстрее, как сказал Рон: 1 с, 195 мс !!!Спасибо

Sub InvertRangeRows(ByRef rngRange_IO As Range)

Dim RowI&, RowRange&, RowArray&, RowFirst As Long
Dim RowLast&, ColumnFirst&, ColumnLast As Long
Dim ArrayRange As Variant, ArrayInverted As Variant
Dim RowCurrent As Variant

Application.ScreenUpdating = False

ArrayRange = rngRange_IO
ReDim ArrayInverted(1 To UBound(ArrayRange))

For RowI = UBound(ArrayRange) To LBound(ArrayRange) Step -1
    RowCurrent = Application.WorksheetFunction.Index(ArrayRange, RowI, 0)
    RowRange = RowRange + 1
    ArrayInverted(RowRange) = RowCurrent
Next RowI

With rngRange_IO
    RowFirst = .Row
    RowLast = RowFirst + UBound(ArrayRange) - 1
    ColumnFirst = .Column
    ColumnLast = ColumnFirst + UBound(ArrayRange, 2) - 1
End With

With rngRange_IO.Worksheet
    For RowI = RowFirst To RowLast
        RowArray = RowArray + 1
        .Range(.Cells(RowI, ColumnFirst), .Cells(RowI, ColumnLast)) _
          = ArrayInverted(RowArray)
    Next RowI
End With

Application.ScreenUpdating = False

End Sub

Ответы [ 2 ]

1 голос
/ 11 марта 2019

Этот код не намного быстрее (1k x 1k) за 1 мин 28 с, но проще.

Dim ws As Worksheet, lRow As Long, i As Long

Set ws = ThisWorkbook.Worksheets("Sheet1")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Application.Calculation = xlCalculationManual
    For i = 2 To lRow
        ws.Cells(i, 1).EntireRow.Cut
        ws.Cells(1, 1).EntireRow.Insert Shift:=xlDown
    Next i
Application.Calculation = xlCalculationAutomatic
0 голосов
/ 11 марта 2019

Я делюсь кодом по предложению @Rory и Ron Rosenfeld. Я включил выключение расчета, чтобы он позволял включать формулы. Это самый быстрый код: 1.2 с против 2'18.6 "моего первого кода !!! Спасибо

Sub InvertRangeRows(ByRef rngRange_IO As Range)
Dim RowI&, RowCurrent&, ColumnI As Long
Dim ArrayRange As Variant, ArrayInverted As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

ArrayRange = rngRange_IO
ReDim ArrayInverted(1 To UBound(ArrayRange), 1 To UBound(ArrayRange, 2))

For RowI = UBound(ArrayRange) To 1 Step -1
    RowCurrent = RowCurrent + 1
    For ColumnI = 1 To UBound(ArrayRange, 2)
        ArrayInverted(RowCurrent, ColumnI) = ArrayRange(RowI, ColumnI)
    Next ColumnI
Next RowI

rngRange_IO = ArrayInverted

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...