Question

我对Excel VBA还是很陌生，我目前正在尝试从多行中获取数据并将其转置为单列。我知道数据的第一个单元格将从何处开始，但这就是我所知道的。数据的每一行都是大小不同的行，并且列的数量也可以变化。

所以我当前的方法是使用某种转置，在这里我只是选择一个很大的范围（希望它捕获了我所有的数据），然后进行转置。尽管确实很慢，但它确实有效，并且还包括了我范围内的所有空白。

Sub transpose()
    Dim InputRange As Range
    Dim OutputCell As Range

    Set InputRange = Sheets("Sheet1").Range("P1:AC100")

    'output will begin at this cell and continue down.
    Set OutputCell = Sheets("Sheet1").Range("A1")   

    For Each cll In InputRange
        OutputCell.Value = cll.Value
        Set OutputCell = OutputCell.Offset(1, 0)
    Next
End Sub

当前的方法不是最差的，但是我敢肯定，有更好的方法可以更快地忽略空白。我不确定实际的转置是最好的方法，还是使用某种循环方法。数据通常包含在200行和10列内（如果这有助于确定方法）（也许循环可能足够快）。任何帮助将不胜感激！

编辑

我发现了一种忽略空格的方法：

For Each cll In InputRange
  If Not IsEmpty(cll.Value) Then
    OutputCell.Value = cll.Value
    Set OutputCell = OutputCell.Offset(1, 0)
  End If
Next

Answer 1

您可以做的一件事是不要循环整个范围，而只需循环SpecialCells。

根据inputRange的内容，然后可以选择要使用的XlCellType。

如果它只是硬编码的值，那么xlCellTypeConstants将对您来说很好。另外，您可能正在查看公式，在这种情况下，您可能想使用xlCellTypeFormulas。如果您同时需要两者，也可以使用Union。

这里是仅使用xlCellTypeConstants

的示例

Sub transposes()

    ' Example just for hardcoded data
    Dim inputRange As Range
    Set inputRange = Sheets("Sheet1").Range("P1:AC100").SpecialCells(xlCellTypeConstants)

    Dim outputCell As Range
    Set outputCell = Sheets("Sheet1").Range("A1")

    Dim cell As Range
    For Each cell In inputRange
        Dim offset As Long
        outputCell.offset(offset).Value = cell.Value
        offset = offset + 1
    Next cell

End Sub

Answer 2

Option Explicit

Public Sub Range_2_Column_Skip_VbNUllString()
' Test Covered
'
    Range_2_Column Cells(1, 1).CurrentRegion, _
            Cells(1, 5), vbNullString

End Sub

Public Function Range_2_Column( _
        ByVal r_Sour As Range, _
        cell_Dest As Range, _
        ByVal sKip As String)
' Test Covered

    A2_2_Range A2_From_Coll( _
            Coll_From_A2_Skip( _
            A2_From_Range(r_Sour), sKip)), cell_Dest

End Function

Public Sub A2_2_Range( _
        a2() As Variant, _
        cell As Range)
' Test Covered
    cell.Resize( _
            UBound(a2), UBound(a2, 2)).Value = _
            a2

End Sub

Public Function A2_From_Range( _
        ByVal r As Range) _
        As Variant()
' Test Covered
'
    A2_From_Range = r.Value

End Function

Public Function Coll_From_A2_Skip( _
        a2() As Variant, _
        ByVal sKip As String) _
        As Collection
' Test Covered
'
    Dim coll As New Collection

    Dim v As Variant

    For Each v In a2
        If v <> sKip Then
            coll.Add v
        End If
    Next

    Set Coll_From_A2_Skip = coll

End Function

Public Function A2_From_Coll( _
        ByVal coll As Collection) _
        As Variant()
' Test Covered
'
    ReDim a2(1 To coll.Count, 1 To 1) As Variant

    Dim v As Variant
    Dim iCount As Long
    iCount = 1

    For Each v In coll
        a2(iCount, 1) = v
        iCount = iCount + 1
    Next

    A2_From_Coll = a2

End Function

Answer 3

这种“蛇”方法对我来说很好。

Sub Snake()
   Dim N As Long, i As Long, K As Long, j As Long
   Dim sh1 As Worksheet, sh2 As Worksheet
   K = 1
   Set sh1 = Sheets("Sheet1")
   Set sh2 = Sheets("Sheet2")
   N = sh1.Cells(Rows.Count, "A").End(xlUp).Row

   For i = 1 To N
      For j = 1 To Columns.Count
         If sh1.Cells(i, j) <> "" Then
            sh2.Cells(K, 1).Value = sh1.Cells(i, j).Value
            K = K + 1
         Else
            Exit For
         End If
      Next j
   Next i
End Sub

之前：

之后：

如何将不同大小的行转置为一列

编辑

3 个答案: