Как переместить строки разных размеров в один столбец

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

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 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