Вопрос по транспонированию массива.

[GoreProgrammist]

Добрый день.

Просьба подсказать как мне побороть такую вещь:
на листе есть массив состоящий из строк с разным кол-ом заполненных ячеек.
Нужно все данные привести в один столбец.

т.е. было так, ячейки через запятую:
A,B,C,D,E,F
1 строка: 1,2,ок,нет,5
2 строка: 5,7
3 строка: ок,8,123

а должно быть всё в столбце А:

1
2
ок
нет
5
5
7
ок
8
123

верю, что есть какое то простое решение отличное от транспонирования вручную 1700 строк.

[nerv]

\немножко благотворительности : )

Sub io()
Dim v, x, j(), i As Long
With ActiveSheet.UsedRange
    ReDim j(1 To .Rows.Count * 7, 1 To 1) ' Размер массива. Если не хватит, можете увеличить
    For Each v In .Value
        For Each x In Split(v, ",")
            If x <> "" Then i = i + 1: j(i, 1) = x
        Next
    Next
    .Parent.Next.[A1].Resize(i) = j() ' Вывод результатов на следующий лист после активного
End With
End Sub

[GoreProgrammist]

Сообщение от nerv

\немножко благотворительности : )

Sub io()
Dim v, x, j(), i As Long
With ActiveSheet.UsedRange
    ReDim j(1 To .Rows.Count * 7, 1 To 1) ' Размер массива. Если не хватит, можете увеличить
    For Each v In .Value
        For Each x In Split(v, ",")
            If x <> "" Then i = i + 1: j(i, 1) = x
        Next
    Next
    .Parent.Next.[A1].Resize(i) = j() ' Вывод результатов на следующий лист после активного
End With
End Sub

Спасибо! Работает, только возможно сделать так что бы если в ячейке есть "," она не разваливалась на 2. То есть не зависимо от того что записано в ячейку, всё её содержимое не менялось.
И ещё вопрос по поводу размера массива, как выставить 15 столбцов на 1710 строк?

[nerv]

как понял. Больше переделывать не буду.

Sub io()
Dim v, x(), i&
With ActiveSheet.UsedRange
    ReDim x(1 To .Rows.Count * .Columns.Count, 1 To 1)
    For Each v In .Value
        If v <> "" Then i = i + 1: x(i, 1) = v
    Next
    .Parent.Next.[A1].Resize(i) = x()
End With
End Sub

[GoreProgrammist]

Сообщение от nerv

как понял. Больше переделывать не буду.

Sub io()
Dim l, v, x(), i&
With ActiveSheet.UsedRange
    ReDim x(1 To .Rows.Count * .Columns.Count, 1 To 1)
    For Each v In .Value
        If v <> "" Then i = i + 1: x(i, 1) = v

    Next
    .Parent.Next.[A1].Resize(i) = x()
End With
End Sub

Ясно, спасибо. Только не работает ни тот, ни этот код, при выполнении кода транспонируются только первые ячейки из строки, то есть просто происходит копирование столбца одного листа в столбец следующего. Я так понимаю цикл должен идти по ячейкам строки слева-напрво, и в случае если следующая по счёту ячейка пустая, переходить на след строку...

[nerv]

Ответ на Ваш вопрос здесь http://programmersforum.ru/announcement.php?f=20

[GoreProgrammist]

Сообщение от nerv

Ответ на Ваш вопрос здесь http://programmersforum.ru/announcement.php?f=20

Вот, залил пример в формате Excel 2007. Нужно все ячейки в неизменном виде расположить в столбец на другом листе. Буду благодарен, если кто нибудь откликнется и поможет.

[Hugo121]

Sub tt()
    Dim cc As Range, i&
    Application.ScreenUpdating = False
    For Each cc In Sheets(1).UsedRange
        If Len(cc.Value) Then
            i = i + 1
            Sheets(2).Cells(i, 1).Value = cc.Value
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Мой вариант и вариант nerv дают одинакове количество строк - 2819, но вариант nerv работает конечно быстрее.
А разница в порядке перебора данных - интересно, почему?

[nerv]

Сообщение от GoreProgrammist

Вот, залил пример в формате Excel 2007. Нужно все ячейки в неизменном виде расположить в столбец на другом листе. Буду благодарен, если кто нибудь откликнется и поможет.

Второй мой код с этим справлялся. НАДО ГОВОРИТЬ ТОЧНЕЕ ЧТО ВАМ НУЖНО И ПРИКЛАДЫВАТЬ ПРИМЕР В ФАЙЛЕ.
Это как понимать?

Сообщение от GoreProgrammist

Спасибо! Работает, только возможно сделать так...

Сообщение от GoreProgrammist

Ясно, спасибо. Только не работает ни тот, ни этот код...

Sub io()
Dim v, z, x(), i&
With ActiveSheet.UsedRange
    ReDim x(1 To .Rows.Count * .Columns.Count, 1 To 1)
    For Each z In .Rows
        For Each v In z.Value
            If v <> "" Then i = i + 1: x(i, 1) = v
        Next
    Next
    .Parent.Next.[A1].Resize(i) = x()
End With
End Sub

[GoreProgrammist]

Сообщение от nerv

Второй мой код с этим справлялся. НАДО ГОВОРИТЬ ТОЧНЕЕ ЧТО ВАМ НУЖНО И ПРИКЛАДЫВАТЬ ПРИМЕР В ФАЙЛЕ.
Это как понимать?

Sub io()
Dim v, z, x(), i&
With ActiveSheet.UsedRange
    ReDim x(1 To .Rows.Count * .Columns.Count, 1 To 1)
    For Each z In .Rows
        For Each v In z.Value
            If v <> "" Then i = i + 1: x(i, 1) = v
        Next
    Next
    .Parent.Next.[A1].Resize(i) = x()
End With
End Sub

Класс, ребята, вы асы, спасибо вам большое!