ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Неполное транспонирование ...?
8 сообщений из 8, страница 1 из 1
Неполное транспонирование ...?
    #34411968
Maksim1976
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maksim1976
Гость
Господа, а каким образом посредством VBA выбрать ненулевые значения из одномерного диапазона (горизонтально лежащего) с одного листа и вставить в вертикально стоящий диапазон на другом листе?

Например:
на Лист1 в диапазоне А1:А5 числа: 3, 2, 0, 1, 0.
на Лист2 вставить, например в диапазон C3:С5, значения 3, 2, 1.
...
Рейтинг: 0 / 0
23.03.2007, 15:19:33
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #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
23.03.2007, 16:32:58
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #34413602
Maksim1976
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maksim1976
Гость
Работает великолепно!

А при переносе из горизонтально лежащего в вертикально стоящий диапазон отображаются почему-то только значения первого ненулевого элемента...
...
Рейтинг: 0 / 0
24.03.2007, 17:59:57
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #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, 00:18:55
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #34413793
Maksim1976
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maksim1976
Гость
Слов нет!
It's working!!!

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

Только непонятно как к ним обращаться - посредством цикла ?
В Range("A1:D3") указывать ((Cells(1,1),Cells(3,3))?
...
Рейтинг: 0 / 0
25.03.2007, 01:25:39
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #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:35:40
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #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, 01:54:27
| Ответить | Цитировать | Написать  
Неполное транспонирование ...?
    #34414325
Maksim1976
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maksim1976
Гость
Уважаемый KL (XL), с Вашей помощью накорябал приатаченный макрос.
Вроде работает.

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

Вообще то, по настоящему, на один лист нужно собирать данные с 4 или 5 листов.
Хорошо, хоть на всех этх листах диапазоны имеют одинаковое расположение и размер, отличаются только типы данных.
Нужно просто вставить цикл по листам?
...
Рейтинг: 0 / 0
25.03.2007, 22:43:24
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Неполное транспонирование ...?
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=289&tid=2183245]:
 0ms
get settings:
 5ms
get forum list:
 13ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 32ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 31ms
get tp. blocked users:
 1ms
others: 201ms
total:  296ms
созд. / загр.: 296ms
x
x
Закрыть


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