Как скопировать несмежные столбцы и скопировать все, кроме первой 2-й и последней 1-й строки без обрезки? Обрезка занимает много времени при большом количестве строк

Question

Как копировать несмежные столбцы и копировать все, кроме первой 2 и последней 1 строки без обрезки? Обрезка занимает много времени, когда строк много. Я переупорядочиваю после копирования. Я хочу скопировать без переупорядочения, например, копировать столбцы c, a, h, f, o, l все, кроме первой 2 и последней 1 строки

Columns("F:F").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("F:F").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("T:T").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll Down:=69
ActiveWindow.LargeScroll Down:=-4
Range(Range("C3"), Range("I3").End(xlDown).Offset(-1, 0)).Select
Selection.Copy

Answer 1

Изменение порядка столбцов с помощью функции Application.Index()

Этот быстрый подход не копирует отдельные диапазоны, но вместо этого использует массивы и демонстрирует расширенные возможности функции Application.Index() позволяет переставлять структуру внутренних строк и столбцов одной строкой кода (~> см. Раздел [3] в процедуре Sub Rearrange() ниже).

Это решение предполагает, чтоВы хотите новый порядок столбцов, состоящий из только из пяти (исходных) столбцов данных C, A, H, F и O, тем самым удаляя все не включенные столбцы - ноВы можете легко изменить константу NEWCOLUMNORDER на любую другую комбинацию, если вы хотите включить дополнительно или все столбцы.

Основная процедура Rearrange

Sub ReArrange()
With Sheet1             ' using the CodeName of a sheet, see (Name) in Property Tool Window
  Const NEWCOLUMNORDER As String = "C,A,H,F,O"
  ' [0] Define data range as well as first and last row (checking e.g. column A:A)
    Dim firstRow As Long, lastRow As Long
    firstRow = 3: lastRow = .Range("A" & .Rows.count).End(xlUp).Row
    Dim rng As Range
    Set rng = .Range("A" & firstRow & ":O" & lastRow - 1) ' start from 3rd row
  ' [1] assign data values to (1-based) 2-dimensional variant array
    Dim v As Variant
    v = rng.Value2
  ' [2] empty original data range (omitting last row)
    rng.Resize(lastRow - firstRow).Clear
  ' [3] Rearrange array rows & columns
    v = Application.Index(v, _
        Evaluate("row(1:" & lastRow - firstRow & ")"), _
        ColNos(NEWCOLUMNORDER))
  ' [4] Write array back to range
    rng.Resize(UBound(v), UBound(v, 2)) = v
End With
End Sub

Обратите внимание, что я предпочитаю использовать уникальный лист CodeName, связанный с вашим проектом VBA (~> см. Строку кода With Sheet1), избегая, например, проблем после переименования листов через листвкладка (по умолчанию начиная симя, идентичное его CodeName в окне VBE с (Name) в скобках!). Конечно, можно также сослаться, например, With ThisWorkbook.Worksheets("Sheet1").

Вспомогательная функция ColNos()

Function ColNos(ByVal s, Optional ByVal DELIM$ = ",") As Variant()
'Purpose: return array of column numbers
'Example: "C,A,H,F,O" ~~> Array(3,1,8,6,15)
s = Split(s, DELIM)         ' split string into individual column letters
ReDim tmp(0 To UBound(s))   ' define array's (1st) dimension via array indices
Dim i&                      ' zero based items counter
For i = 0 To UBound(s)      ' loop through column letters, e.g. C,A,H,F,O
    tmp(i) = Columns(s(i) & ":" & s(i)).Column ' get column number
Next i
ColNos = tmp                ' return temporary array items
End Function