Инверсные/обратные столбцы, которые не имеют заданного диапазона, используя командную кнопку

Question

Я знаю, что этот вопрос уже задан, но я не могу представить, что я нахожу для меня работой.

Я просто хочу принять все данные, начиная в колонке А, и собирается на колонке J из строки 2 к тому, что конец данных может быть и в обратном порядке (обратный данные)

я наткнулся на код ниже, но он зависает, и я не хочу делать выбор.

Private Sub CommandButton2_Click() 

    Dim vTop As Variant 
    Dim vEnd As Variant 
    Dim iStart As Integer 
    Dim iEnd As Integer 

    Application.ScreenUpdating = False 
    iStart = 1 
    iEnd = Selection.Columns.Count 

    Do While iStart < iEnd 
     vTop = Selection.Columns(iStart) 
     vEnd = Selection.Columns(iEnd) 
     Selection.Columns(iEnd) = vTop 
     Selection.Columns(iStart) = vEnd 
     iStart = iStart + 1 
     iEnd = iEnd - 1 
    Loop 
    Application.ScreenUpdating = True 

End Sub 

Чтобы быть ясным, я хочу сделать последнюю строку первой строкой, а последнюю строку - первой. Это непрерывный блок данных. Приветствия

before after

Answer 1

Другая версия кода - посмотрите, работает ли это.

Private Sub CommandButton2_Click() 

Dim v(), i As Long, j As Long, r As Range 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

With Range("A1").CurrentRegion 
    Set r = .Offset(1).Resize(.Rows.Count - 1) 
End With 

ReDim v(1 To r.Rows.Count, 1 To r.Columns.Count) 

For i = 1 To r.Rows.Count 
    For j = 1 To r.Columns.Count 
     v(i, j) = r(r.Rows.Count - i + 1, j) 
    Next j 
Next i 

r = v 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 

Answer 2

Как так? Это предполагает непрерывный блок данных из A2 (The CurrentRegion), так что будет выходить за пределы J, если имеется больше данных, но может быть ограничен

Private Sub CommandButton2_Click() 

Dim v, i As Long, r As Range 

Application.ScreenUpdating = False 

With Range("A1").CurrentRegion 
    Set r = .Offset(1).Resize(.Rows.Count - 1) 
End With 

v = r 

For i = 1 To r.Rows.Count 
    r.Rows(i).Cells = Application.Index(v, r.Rows.Count - i + 1, 0) 
Next i 

Application.ScreenUpdating = True 

End Sub 

Answer 3

Приведенный ниже код копирует данные в каждом столбце в колонке № 20 - ток индекс столбца, а в конце цикла For он удаляет исходные данные, которые находятся в столбцах A: J.

Option Explicit 

Private Sub CommandButton2_Click() 

Dim LastRow As Long 
Dim Col As Long 
Dim ColStart As Long, ColEnd As Long 

Application.ScreenUpdating = False 

' Column A 
ColStart = 1 
' Column J 
ColEnd = 10 ' Selection.Columns.Count 

' modify "Sheet1" to your sheet's name 
With Sheets("Sheet1") 
    For Col = ColStart To ColEnd 
     ' find last row with data for current column 
     LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 

     ' copy in reverse order to column 20 to 11 
     ' copy current column to column 20-current column index 
     .Range(Cells(2, Col), Cells(LastRow, Col)).Copy .Range(Cells(2, 20 - Col), Cells(LastRow, 20 - Col)) 
    Next Col 
End With 

' delete original data in column A:J 
With Sheets("Sheet1") 
    .Columns("A:J").EntireColumn.Delete 
End With 

Application.ScreenUpdating = True 

End Sub