Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.11.2016, 12:33   #1
wtb
 
Регистрация: 08.11.2009
Сообщений: 5
По умолчанию Преобразование массива

Добрый день!
Есть такая задачка: в прикрепленном файле массив. Первой его ячейкой является L3. Первые 2 строки сверху и столбцы A-K - это "шапки".
Нужен скрипт, который при запуске ищет непустые ячейки в массиве и когда находит, то создает на втором листе строку, в которую заносит
1. значения из столбцов B,С,D,E,F, находящиеся в строке найденной непустой ячейки
2. значение из 1-ой строки столбца, в котором находится непустая ячейка
3. значение из самой ячейки
Таким образом на второй странице получается новый массив из 7 стоблцов, в котором кол-во строк равно кол-ву заполненных ячеек из первого массива.

Буду благодарен за помощь!
Вложения
Тип файла: zip Преобразование массива.zip (67.4 Кб, 7 просмотров)
wtb вне форума Ответить с цитированием
Старый 19.11.2016, 12:37   #2
wtb
 
Регистрация: 08.11.2009
Сообщений: 5
По умолчанию

Вот скриншот, т.е. если есть заполненная ячейка, нужно подтянуть к ней значения в овалах...
[IMG]Преобразование массива.jpg[/IMG]
wtb вне форума Ответить с цитированием
Старый 19.11.2016, 14:32   #3
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

надо еще 1 лист - "Лист1"
Код:
Sub smth()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim r, c, r1
    Dim lastRow As Long, rightCol As Long
    Set sh1 = Sheets("Опорный массив")
    Set sh2 = Sheets("Лист1")
    sh2.Cells.Clear
    Application.ScreenUpdating = False
    With sh1
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        rightCol = .Cells(2, Columns.Count).End(xlToLeft).Column
        r1 = 2
        For r = 3 To lastRow
            For c = 12 To rightCol
                If .Cells(r, c) <> "" Then
                    sh2.Cells(r1, 1) = .Cells(r, 2)
                    sh2.Cells(r1, 2) = .Cells(r, 3)
                    sh2.Cells(r1, 3) = .Cells(r, 4)
                    sh2.Cells(r1, 4) = .Cells(r, 5)
                    sh2.Cells(r1, 5) = .Cells(r, 6)
                    sh2.Cells(r1, 6) = .Cells(2, c)
                    r1 = r1 + 1
                End If
            Next c
        Next r
    End With
    Application.ScreenUpdating = True
    MsgBox "Готово!"
    Set sh1 = Nothing
    Set sh2 = Nothing
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 19.11.2016, 14:51   #4
wtb
 
Регистрация: 08.11.2009
Сообщений: 5
По умолчанию

Александр, благодарю!!
Написал вам в скайпе
wtb вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Преобразование массива C++ ksly Общие вопросы C/C++ 3 16.10.2015 10:18
Преобразование массива c++ ksly Помощь студентам 0 11.10.2015 23:14
С# преобразование массива gvozdik12 Помощь студентам 4 16.05.2013 07:53
преобразование массива kuzya1994 Паскаль, Turbo Pascal, PascalABC.NET 0 08.02.2012 23:20
преобразование массива PARTOS Microsoft Office Excel 4 20.01.2010 17:21