Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Неполное транспонирование ...? / 8 сообщений из 8, страница 1 из 1
23.03.2007, 15:19:33
    #34411968
Maksim1976
Maksim1976
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Господа, а каким образом посредством VBA выбрать ненулевые значения из одномерного диапазона (горизонтально лежащего) с одного листа и вставить в вертикально стоящий диапазон на другом листе?

Например:
на Лист1 в диапазоне А1:А5 числа: 3, 2, 0, 1, 0.
на Лист2 вставить, например в диапазон C3:С5, значения 3, 2, 1.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.03.2007, 16:32:58
    #34412286
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub test()
    Dim c As Range, arr, i As Long
    ReDim arr(Application.CountIf(Sheets( 1 ).Range("A1:A5"), ">0") -  1 )
    
    For Each c In Sheets( 1 ).Range("A1:A5")
        If c >  0  Then
            arr(i) = c
            i = i +  1 
        End If
    Next c
    Sheets( 2 ).Range("C3").Resize(, UBound(arr) +  1 ) = arr
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.03.2007, 17:59:57
    #34413602
Maksim1976
Maksim1976
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Работает великолепно!

А при переносе из горизонтально лежащего в вертикально стоящий диапазон отображаются почему-то только значения первого ненулевого элемента...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.03.2007, 00:18:55
    #34413774
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Maksim1976А при переносе из горизонтально лежащего в вертикально стоящий диапазон отображаются почему-то только значения первого ненулевого элемента...

Это потому что векторы исходного массива и ранга назначения не совпадают . Массив arr - одномерный, а одномерные массивы в VBA всегда (!) горизонтальны .

Выхода два:

- либо транспонируем исходный массив (arr) перед копированием
- либо изначально создаем исходный массив (arr) как двухмерный

Я предпочитаю первое:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub test()
    Dim c As Range, arr, i As Long
    ReDim arr(Application.CountIf(Sheets( 1 ).Range("A1:A5"), ">0") -  1 )
    
    For Each c In Sheets( 1 ).Range("A1:A5")
        If c >  0  Then
            arr(i) = c
            i = i +  1 
        End If
    Next c
    Sheets( 2 ).Range("C3").Resize(UBound(arr) +  1 ) = Application.Transpose(arr)
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.03.2007, 01:25:39
    #34413793
Maksim1976
Maksim1976
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Слов нет!
It's working!!!

А если в качестве исходного задан двухмерный массив, то его строки, насколько я понимаю, можно обрабатывать таким же образом?

Только непонятно как к ним обращаться - посредством цикла ?
В Range("A1:D3") указывать ((Cells(1,1),Cells(3,3))?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.03.2007, 01:35:40
    #34413794
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Maksim1976А если в качестве исходного задан двухмерный массив, то его строки, насколько я понимаю, можно обрабатывать таким же образом?

Только непонятно как к ним обращаться - посредством цикла ?
В Range("A1:D3") указывать ((Cells(1,1),Cells(3,3))?

Необязательно. Вот пример с двухмерным массивом:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub test()
    Dim c As Range, arr, i As Long
    ReDim arr(Application.CountIf(Sheets( 1 ).Range("A1:A5"), ">0") -  1 ,  0 )
    
    For Each c In Sheets( 1 ).Range("A1:A5")
        If c >  0  Then
            arr(i,  0 ) = c
            i = i +  1 
        End If
    Next c
    Sheets( 2 ).Range("C3").Resize(UBound(arr) +  1 ) = arr
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.03.2007, 01:54:27
    #34413796
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Естественно, есть еще более короткий, но, при большом кол-ве данных, более медленный вариант:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub testGorizontal()
    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    With Sheets( 1 ).Range("A1")
        For i =  1  To  5 
            If .Cells(i) >  0  Then
                Sheets( 2 ).Range("C3")( 1 , j +  1 ) = .Cells(i)
                j = j +  1 
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub testVertical()
    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    With Sheets( 1 ).Range("A1")
        For i =  1  To  5 
            If .Cells(i) >  0  Then
                Sheets( 2 ).Range("C3")(j +  1 ) = .Cells(i)
                j = j +  1 
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.03.2007, 22:43:24
    #34414325
Maksim1976
Maksim1976
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Неполное транспонирование ...?
Уважаемый KL (XL), с Вашей помощью накорябал приатаченный макрос.
Вроде работает.

Прошу высказать критические замечания.

Вообще то, по настоящему, на один лист нужно собирать данные с 4 или 5 листов.
Хорошо, хоть на всех этх листах диапазоны имеют одинаковое расположение и размер, отличаются только типы данных.
Нужно просто вставить цикл по листам?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Неполное транспонирование ...? / 8 сообщений из 8, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 322ms
Закрыть
start [/forum/topic.php?fid=61&mobile=1&tid=2183245]:
 0ms
get settings:
 7ms
get forum list:
 18ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 27ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 53ms
get tp. blocked users:
 2ms
others: 195ms
total:  322ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]