макрос для копирования набора столбцов один под другим

[Светлана512]

Добрый день, подскажите, пожалуйста, возможно ли сделать так, чтобы макрос копировал набор столбцов один под другим?
Иными словами, хочу сделать обратное действие по сравнению с собиранием данных в сводную таблицу
Очень надеюсь на скорую помощь!
спасибо

[GWolf]

Добрый день, подскажите, пожалуйста, возможно ли сделать так, чтобы макрос копировал набор столбцов один под другим?
Иными словами, хочу сделать обратное действие по сравнению с собиранием данных в сводную таблицу
Очень надеюсь на скорую помощь!
спасибо

Добрый вечер!

А примерчиком не озадачите нас? 

[Светлана512]

А вот и пример - на листе 1 то что есть
а на листе 2 - то что должно получиться (все данные должны оказаться с одном столбце, а не в матрице, а также уйти все нулевые значения)

спасибо!

[Wasilic]

Taк пойдёть? 

[Светлана512]

А если исходные данные чуть-чуть модифицированы, можете посмотреть ? 
что-то не получается тогда... 

задача та же, только даты и названия сдвинуты

[GWolf]

А если исходные данные чуть-чуть модифицированы, можете посмотреть ? 
что-то не получается тогда... 

задача та же, только даты и названия сдвинуты

Ну как я и думал: - Следует определить координаты крайних ячеек таблицы, а уж потом модифицировать!!!
От себя могу предложить: как определить крайнюю-правую ячейку, а вот как с наименьшей кровью определить верхнюю-левую?

Итак, для крайней-правой (если на листе только эта таблица!):

Код Выделить Развернуть

Sub proba()
    Dim blok As Range
   
    With ThisWorkbook.ActiveSheet
        'определяем занятую данными область листа == Start ==
        Set blok = .UsedRange
        nREnd = blok.Row + blok.Rows.Count - 1
        nCEnd = blok.Column + blok.Columns.Count
        Set blok = Nothing
        'определяем занятую данными область листа == Stop ==
   
    End With
End Sub


[Wasilic]

Комментарии в макросе.

[GWolf]

Доброго дня, ув. Wasilic!
Я то имел в виду нечто другое:

Есть прямоугольная область листа, не начинающаяся в ячейке A1, как определить ее границы?
Крайние нижнюю-правую - определим, а вот как определить верхнюю-левую?
Как вариант перебирать ячейки, пока не встретим .Text=""? Может есть другие варианты.

Мне кажется, что решив этот вопрос, мы действительно сможем предложить пользователю УНИВЕРСАЛЬНЫЙ макрос, имеющий лишь одно ограничение: Таблица на листе должна быть ОДНА!

Или я не прав?

[_Boroda_]

Если на листе только таблица и только одна, то можно так:

Код Выделить Развернуть

Sub ttt()
r1_ = Range("A1").SpecialCells(xlLastCell).Row
c1_ = Range("A1").SpecialCells(xlLastCell).Column
r0_ = Range("A1").SpecialCells(xlLastCell).CurrentRegion.Row
c0_ = Range("A1").SpecialCells(xlLastCell).CurrentRegion.Column
End Sub

[GWolf]

Если на листе только таблица и только одна, то можно так:

Код Выделить Развернуть

Sub ttt()
r1_ = Range("A1").SpecialCells(xlLastCell).Row
c1_ = Range("A1").SpecialCells(xlLastCell).Column
r0_ = Range("G12").SpecialCells(xlLastCell).CurrentRegion.Row
c0_ = Range("G12").SpecialCells(xlLastCell).CurrentRegion.Column
End Sub

А вот так не лучше будет?

Код Выделить Развернуть

Sub kanvas()
    Dim nRIn As Long, nCIn As Long, nROu As Long, nCOu As Long

    '=== определяем границы == Start ===
    With ThisWorkbook.ActiveSheet
        'определяем крайние:
        nROu = Range(.Cells(1, 1), .Cells(1, 1)).SpecialCells(xlLastCell).Row
        nCOu = Range(.Cells(1, 1), .Cells(1, 1)).SpecialCells(xlLastCell).Column
        'стартовые
        nRIn = Range(.Cells(nROu, nCOu), .Cells(nROu, nCOu)).SpecialCells(xlLastCell).CurrentRegion.Row
        nCIn = Range(.Cells(nROu, nCOu), .Cells(nROu, nCOu)).SpecialCells(xlLastCell).CurrentRegion.Column
    End With
    '=== определяем границы == Stop ====
End Sub


[_Boroda_]

Это у меня ошибка случайная закралась в код
Не G12, а A1 должно быть в 2-х последних строках. Поменял в посте выше

[GWolf]

Это у меня ошибка случайная закралась в код
Не G12, а A1 должно быть в 2-х последних строках. Поменял в посте выше

Прикольно! Но так как у меня тоже работает! Хотя Вы правы Маэстро! Единственное - не люблю я абсолютные ссылки, но в данном примере А1 он и в Африке А1!

P.S.
Порылся в help ... Как вы коллеги думаете? Не правельнее ли будет вот такой код:

Код Выделить Развернуть

Sub kanvas()
    Dim nRIn As Long, nCIn As Long, nROu As Long, nCOu As Long

    '=== определяем границы == Start ===
    With ThisWorkbook.ActiveSheet
        'определяем крайние:
        nROu = Range(.Cells(1, 1), .Cells(1, 1)).SpecialCells(xlLastCell).Row
        nCOu = Range(.Cells(1, 1), .Cells(1, 1)).SpecialCells(xlLastCell).Column
        'стартовые
        nRIn = Range(.Cells(nROu, nCOu), .Cells(nROu, nCOu)).CurrentRegion.Row
        nCIn = Range(.Cells(nROu, nCOu), .Cells(nROu, nCOu)).CurrentRegion.Column
    End With
    '=== определяем границы == Stop ====
End Sub


Хотя все три варианта определяют вроде правильные значения, но чисто МЕТОДОЛОГИЧЕСКИ? Хотелось бы узнать!

[Wasilic]

Мне кажется, что решив этот вопрос, мы действительно сможем предложить пользователю УНИВЕРСАЛЬНЫЙ макрос, имеющий лишь одно ограничение: Таблица на листе должна быть ОДНА!

Или я не прав?

Прав конечно. Но, дайте же и пользователью возможность пошевелить серым веществом.
Был первый пример. Я подсказал путь решения задачи. Оказывается, это "путь в темном лесу".
В следующем примере я описал "каждое дерево этого леса".
Ну а вы решили еще и просеку прорубить.    А что же пользователю останется.  
ИМХО. Пока пользователь не поймет сам принцип работы макроса.  То и универсальный ему не поможет. Такой вот юмор! Без обид! И пользователь  тоже.
ЗЫ. А ведь в примере цикл нужен все же не из первой строки и не из первого столбца таблицы. А еще у кого-то потребуется еще иначе. Вот Вам и универсальность.
Без серого вешества никак.

[GWolf]

... Но, дайте же и пользователью возможность пошевелить серым веществом.
Был первый пример. Я подсказал путь решения задачи. Оказывается, это "путь в темном лесу".
В следующем примере я описал "каждое дерево этого леса".
Ну а вы решили еще и просеку прорубить.    А что же пользователю останется. 
ИМХО. Пока пользователь не поймет сам принцип работы макроса.  То и универсальный ему не поможет. Такой вот юмор!

А пользователи у нас, задав вопрос - нервно курят в кустах! Или чего они еще там делают?!  Стало почти среднестат нормой задавать конкретный вопрос без примера; помалкивать пока мы тут делаем попытки - отвечаем, получается сами себе на заявленную тему. Я не хочу никого обидеть, но ГАСПАДА, майте совесть! Задали тему, так курируйте ее. Ну хотя бы напишите что типа Ваш, товарищь который ответил, макрос не работает. А то сколь раз ужо было: предлагаем -  предлагаем, а в результате на 18-20 сообщении: - Я не очень волоку в макросах ... Ну воот и приехали! С этого следовало бы начать.
А позвольте спросить: - Почему не волоку, то? Мы ведь тоже не с макросами родились. Единственное наше желание, это повышать свой уровень обмениваясь накопленным багажом. А вот решать задачки для лентяев - это к фрилансерам.

Извините если что не так.

[Wasilic]

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