Перевернуть полный лист Excel

Question

Я хочу инвертировать весь лист, что означает, что первая строка становится последней строкой, последняя строка становится первой строкой и т. Д. (Без изменения столбцов).

Единственный способ, которым я считаюиз, работает по строкам снизу вверх и копирует каждую строку на новый лист.

Answer 1

1. Вставить фиктивный столбец
2. Заполнить по номеру
3. Сортировать по убыванию

4. Удалить пронумерованный столбец

   Dim ws As Worksheet
   Dim i As Long
   
   Set ws = ActiveWorkbook.Worksheets("Sheet1")
   
   Columns("A:A").Insert Shift:=xlToRight
   For i = 1 To ws.UsedRange.Rows.Count
       ws.Cells(i, 1) = i
   Next i
   
   With ws.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("A1"), Order:=xlDescending
       .SetRange ws.UsedRange
       .Apply
   End With
   
   Columns("A:A").Delete
   

Answer 2

Я знаю, у вас уже есть ответ;но я всегда стараюсь сделать vba максимально простым.Просто измените ThisWorkbook.Worksheets("Sheet1") в соответствии с вашими потребностями.

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

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

    For i = 2 To lRow
        ws.Cells(i, 1).EntireRow.Cut
        ws.Cells(1, 1).EntireRow.Insert Shift:=xlDown
    Next i

Answer 3

Скука должна быть заразной.

Sub FlipTheScript()
    Dim data As Variant, result As Variant

    data = ThisWorkbook.Worksheets("Sheet1").UsedRange.Value
    ReDim result(1 To UBound(data), 1 To UBound(data, 2))

    Dim r As Long, c As Long

    For r = 1 To UBound(data)
        For c = 1 To UBound(data, 2)
            result(UBound(data) - r + 1, c) = data(r, c)
        Next
    Next

    ThisWorkbook.Worksheets("Sheet1").UsedRange.Value = result
End Sub

Answer 4

Хорошо, мне стало скучно, и я решил просто написать это очень быстро.

Private Sub this()
    Dim pickUp As Variant
    Dim newArr() As String
    Dim rowC As Long, colC As Long, i As Long, j As Long, z As Long

    rowC = ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
    z = rowC
    colC = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns.Count
    ReDim newArr(1 To rowC, 1 To colC)
    pickUp = ThisWorkbook.Worksheets("Sheet1").UsedRange

    For i = LBound(pickUp, 1) To UBound(pickUp, 1)
        For j = LBound(pickUp, 2) To UBound(pickUp, 2)
            newArr(rowC, j) = pickUp(i, j)
        Next j
        rowC = rowC - 1
    Next i

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    With ws
        ws.Range(.Cells(1, 1), .Cells(z, colC)).Value2 = newArr
    End With
End Sub