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

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

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

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

之前：

之后：

Answer 2

您可以做的一件事是循环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 3

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