Страницы: 1
RSS
Макрос для преобразования таблицы
 
Добрый день. Просьба помочь в создании макроса для преобразования таблицы.

Есть таблица с данными (в файле закладка DATA). Необходимо на выходе (закладка RESULT) получить таблицу содержащую всего 3 столбца. В первом д.б. все (включая дублирующиеся) значения начиная с ячейки "C1" слева направо, сверху вниз, а во втором находящиеся в той же строке значения столбцов А и В.

Важное примечание: ячеек со значениями начиная от столбца C вправо может быть до 250 (много в общем)
Количество строк исходного листа до нескольких тысяч.

Спасибо.
 
Добрый. Можно как-то так:
Скрытый текст
Кому решение нужно - тот пример и рисует.
 
'До нескольких тысяч' и 250-ти столбцов быстрее будет как-то так
Скрытый текст
Изменено: Sanja - 01.03.2017 11:30:35
Согласие есть продукт при полном непротивлении сторон
 
Огромное спасибо. Оба макроса работают. Второй чуть быстрее, но почему-то результирующая таблица начинается со столбца E, хотя это уже мелочи. По времени выполнения оба с оригинальным файлом на 30000 строк тратят в среднем секунд пять. Еще раз спасибо ребята. Отличная работа.
 
Цитата
cheslav написал:
но почему-то результирующая таблица начинается со столбца E
- в код вообще не заглядывали?
Там есть такая часть строки:
Код
Worksheets("RESULT").Range("E1")

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

P.S. Такой вариант должен быть ещё чуть быстрее:
Код
Sub tt()
    Dim arrval()
    Dim I&, J&, N&
    
    arrval = Worksheets("DATA").UsedRange.Value
    ReDim arrTemp(1 To UBound(arrval, 1) * UBound(arrval, 2), 1 To 3)

    For I = 1 To UBound(arrval, 1)
        For J = 3 To UBound(arrval, 2)
            If arrval(I, J) <> Empty Then
                N = N + 1
                arrTemp(N, 1) = arrval(I, J)
                arrTemp(N, 2) = arrval(I, 1)
                arrTemp(N, 3) = arrval(I, 2)
            Else
                Exit For
            End If
        Next
    Next
    Worksheets("RESULT").Range("E1").Resize(N, 3) = arrTemp
End Sub
Изменено: Hugo - 01.03.2017 21:35:39
 
Цитата
cheslav написал: почему-то результирующая таблица начинается со столбца E
Цитата
Hugo написал: чтоб можно было сравнить с заказанным результатом

+1
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Hugo написал:
- в код вообще не заглядывали?
Критику принимаю .Врать не буду... Не заглядывал. Изучение работы макроса в данном случае не было целью. Нужен был быстрый результат - он достигнут. Всем спасибо.

P.S. Последний вариант самый шустрый :)
Страницы: 1
Наверх