Question

我已经看过一些类似的帖子，但不是我需要或可以理解的解决我的简单问题。

我有数百行数据，我想将其转换为列。原始数据是这样的，其间有两个空行，相关数据集的长度可能不同：

9
8
7
6
5
4
3
2
1


J
I
H
G
F    
E
D
C
B
A

我希望能够颠倒每个集合的顺序，然后将它们转换为每个数据集的另一行的列，如下所示：

1   2   3   4   5   6   7   8   9   

A   B   C   D   E   F   G   H   I   J

我在第一部分使用一个简单的公式= OFFSET（$ A $ 2，COUNTA（A：A）-ROW（），0）取得了一些成功，因为我不确定如何在VBA中这样做。

我用来获取所有数据然后进行转置的代码，我无法让它为每个唯一数据集连续下载。这是我尝试使用的代码，但它似乎无法工作，只是开始在工作表上运行，直到宏出现。

Sub TransposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheets("Output").Range("A3:A10002")
 Set OutRange = Sheets("Output").Range("H2:NTR2")

 For i = 1 To 10000 Step 1
  OutRange.Cells(1, i) = InRange.Cells(i, 1)
        ActiveCell.Offset(1, 0).Select
 Next i

End Sub

我确定有一些明显而简单的东西我不知道但是唉，我仍然是训练中的菜鸟。任何建议都将不胜感激。

Answer 1

假设您的数据位于A栏，请尝试使用排序然后使用 pastespecial with transpose 尝试以下操作:(请根据您自己的名称更改工作表名称）

Sub sortNtranspose()
Dim r As Integer
Dim i As Integer
Dim j As Integer
Dim rn As Range
r = Sheets("Sheet1").UsedRange.Rows.Count

For i = 1 To r
Set rn = Range(Cells(i, 1), Cells(Cells(i, 1).End(xlDown).Row, 1))
rn.Sort key1:=Cells(i, 1), order1:=xlAscending, Header:=xlNo
Set rn = Range(Cells(i + 1, 1), Cells(Cells(i, 1).End(xlDown).Row, 1))
rn.Copy
Cells(i, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Do While Not IsEmpty(Cells(i, 1))
If IsEmpty(Cells(i, 2)) Then
Cells(i, 2).EntireRow.Delete
Else:
i = i + 1
End If
Loop

r = Sheets("Sheet1").UsedRange.Rows.Count
If j >= r Then
Exit Sub
End If
j = Cells(i, 1).End(xlDown).Row

i = j - 1
Next i

End Sub

Answer 2

此代码假定您的数据是常量，并使用VBA精彩的SpecialCells属性来打破第1列中的每个块。它还使用一个数组，这比循环遍历单元格要快得多：

Sub TransposeColumnSections()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim ColumnConstants As Excel.Range
Dim i As Long
Dim ColumnArea As Excel.Range
Dim AreaRowsCount As Long
Dim ReversedConstants() As Variant
Dim j As Long

Set ws = ActiveSheet
With ws
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set ColumnConstants = .Columns(1).SpecialCells(xlCellTypeConstants)
    For i = 1 To ColumnConstants.Areas.Count
        Set ColumnArea = ColumnConstants.Areas(i)
        AreaRowsCount = ColumnArea.Rows.Count
        ReDim ReversedConstants(1 To AreaRowsCount)
        For j = AreaRowsCount To 1 Step -1
            ReversedConstants(AreaRowsCount - (j - 1)) = ColumnArea(j).Value
        Next j
        .Cells(i, 2).Resize(1, AreaRowsCount) = ReversedConstants
    Next i
    .Columns(1).Delete
End With
End Sub

获取数据行并转换为具有连续行的列

2 个答案: