Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создание динамической таблицы макросом - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Создание динамической таблицы макросом
gizon Дата: Вторник, 02.10.2018, 22:41 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте, уважаемые форумчане, очень прошу помочь с макросом, нужно чтобы макросом создавалась динамическая таблица из данных в столбце С, но диапазон заранее не известен, как можно сделать так, чтобы макрос автоматически создавал динамическую таблицу с заголовком, со всеми заполненными ячейками из столбца С?
К сообщению приложен файл: 6520409.xls (32.0 Kb)
 
Ответить
СообщениеЗдравствуйте, уважаемые форумчане, очень прошу помочь с макросом, нужно чтобы макросом создавалась динамическая таблица из данных в столбце С, но диапазон заранее не известен, как можно сделать так, чтобы макрос автоматически создавал динамическую таблицу с заголовком, со всеми заполненными ячейками из столбца С?

Автор - gizon
Дата добавления - 02.10.2018 в 22:41
K-SerJC Дата: Среда, 03.10.2018, 09:03 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
Добрый день!
Подойдет как вариант?!
или только динамическая таблица нужна
К сообщению приложен файл: gizon.xls (41.5 Kb)


Благими намерениями выстелена дорога в АД.
 
Ответить
СообщениеДобрый день!
Подойдет как вариант?!
или только динамическая таблица нужна

Автор - K-SerJC
Дата добавления - 03.10.2018 в 09:03
_Boroda_ Дата: Среда, 03.10.2018, 09:27 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация: 6503 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    r0_ = 2
    n_ = Cells(Rows.Count, 3).End(3).Row - r0_ + 1
    c_ = 6
    Columns(c_).Clear
    Range("C2").Resize(n_).Copy Cells(2, c_)
    Cells(2, c_).Resize(n_).SpecialCells(xlCellTypeBlanks).Delete
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("F2").Resize(Cells(Rows.Count, c_).End(3).Row - r0_ + 1), , xlYes).Name = "Tab" & Timer
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 6520409_1.xls (43.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    r0_ = 2
    n_ = Cells(Rows.Count, 3).End(3).Row - r0_ + 1
    c_ = 6
    Columns(c_).Clear
    Range("C2").Resize(n_).Copy Cells(2, c_)
    Cells(2, c_).Resize(n_).SpecialCells(xlCellTypeBlanks).Delete
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("F2").Resize(Cells(Rows.Count, c_).End(3).Row - r0_ + 1), , xlYes).Name = "Tab" & Timer
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 03.10.2018 в 09:27
gizon Дата: Среда, 03.10.2018, 11:16 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
_Boroda_, спасибо огромное, это то что нужно.
K-SerJC, тоже спасибо интересный вариант.


Сообщение отредактировал gizon - Среда, 03.10.2018, 11:16
 
Ответить
Сообщение_Boroda_, спасибо огромное, это то что нужно.
K-SerJC, тоже спасибо интересный вариант.

Автор - gizon
Дата добавления - 03.10.2018 в 11:16
micholap_denis Дата: Четверг, 07.07.2022, 11:31 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 341
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
_Boroda_, подскажите пожалуйста, а как подправить макрос ,что бы брал данные для таблицы из диапазона в несколько столбцов? диапазон учитывался только до пустого столбца
К сообщению приложен файл: 1482411.xlsb (16.6 Kb)
 
Ответить
Сообщение_Boroda_, подскажите пожалуйста, а как подправить макрос ,что бы брал данные для таблицы из диапазона в несколько столбцов? диапазон учитывался только до пустого столбца

Автор - micholap_denis
Дата добавления - 07.07.2022 в 11:31
_Boroda_ Дата: Четверг, 07.07.2022, 11:46 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация: 6503 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Положите файл без макросов. У меня безопасность блокирует скачивание файлов с кодом


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПоложите файл без макросов. У меня безопасность блокирует скачивание файлов с кодом

Автор - _Boroda_
Дата добавления - 07.07.2022 в 11:46
micholap_denis Дата: Четверг, 07.07.2022, 11:49 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 341
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
_Boroda_, вот
К сообщению приложен файл: 8911058.xlsb (10.4 Kb)
 
Ответить
Сообщение_Boroda_, вот

Автор - micholap_denis
Дата добавления - 07.07.2022 в 11:49
_Boroda_ Дата: Четверг, 07.07.2022, 12:50 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация: 6503 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    c0_ = 2
    r0_ = 2
    c_ = 10
    On Error Resume Next
    If Cells(r0_, c_) <> "" Then
        Cells(r0_, c_).CurrentRegion.Clear
    End If
    For i = c0_ To Columns.Count
        If Cells(r0_, i) = "" Then
            Exit For
        Else
            nr_ = Cells(Rows.Count, i).End(3).Row - r0_ + 1
            Cells(r0_, i).Resize(nr_).Copy Cells(r0_, c_ + k_)
            Cells(r0_, c_ + k_).Resize(nr_).SpecialCells(xlCellTypeBlanks).Delete
            k_ = k_ + 1
        End If
    Next i
    ActiveSheet.ListObjects.Add(xlSrcRange, Cells(r0_, c_).CurrentRegion, , xlYes).Name = "Tab" & Timer
    On Error GoTo 0
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 8911058_1.xlsx (9.8 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    c0_ = 2
    r0_ = 2
    c_ = 10
    On Error Resume Next
    If Cells(r0_, c_) <> "" Then
        Cells(r0_, c_).CurrentRegion.Clear
    End If
    For i = c0_ To Columns.Count
        If Cells(r0_, i) = "" Then
            Exit For
        Else
            nr_ = Cells(Rows.Count, i).End(3).Row - r0_ + 1
            Cells(r0_, i).Resize(nr_).Copy Cells(r0_, c_ + k_)
            Cells(r0_, c_ + k_).Resize(nr_).SpecialCells(xlCellTypeBlanks).Delete
            k_ = k_ + 1
        End If
    Next i
    ActiveSheet.ListObjects.Add(xlSrcRange, Cells(r0_, c_).CurrentRegion, , xlYes).Name = "Tab" & Timer
    On Error GoTo 0
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 07.07.2022 в 12:50
micholap_denis Дата: Четверг, 07.07.2022, 13:14 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 341
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
_Boroda_, спасибо...как всегда - шикарно
 
Ответить
Сообщение_Boroda_, спасибо...как всегда - шикарно

Автор - micholap_denis
Дата добавления - 07.07.2022 в 13:14
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!