VBA ссылки на активную ячейку и лист в умной таблицы

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

VBA ссылки на активную ячейку и лист в умной таблицы (Макросы/Sub)

Vlaad79

Дата: Пятница, 24.01.2025, 20:08 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

В книге 100 листов с одинаковыми по форме умными таблицами. Отличие листов и таблиц только в номере. Наименование столбцов и форматы в умной одинаковые. Задача автоматически заполнить значение времени в именованном "Столце2" при редактировании в ячейке "Столбца1" без указания имени активного листа, или редактируемой умной таблицы (макрос сам должен вычислять и подставлять в формулу имя листа и имя активной таблицы)
С первой частью справился а со второй прошу помочь. Имеющиеся варианты макроса через диапазон A1:A100 и "With Target.Offset(0, 1)" не подходят так как количество столбцов может со временем меняться а названия столбцов в умной таблице точно менять не буду. Также интересует вопрос вычисления с ссылками на 2 ячейки умной таблицы. все вычисления в границах листа-умной таблицы.

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WsS As Range
    ActiveTable = ActiveCell.ListObject.Name 'рабочий
    WsS = ActiveSheet.Name
    For Each Cell In Target
        '2 If Not Intersect(cell, Range("A4:A1000")) Is Nothing Then ' работает но не умная таблица
        '3 If Not Intersect(cell, Range("Таблица1[Столбец1]")) Is Nothing Then ' работает но необходимо прописывать вручную каждую таблицу
        If Not Intersect(Cell, Range(ActiveTable & "[Столбец1]")) Is Nothing Then ' работает- то что нужно
            'With Range(("C") & cell.Row) ' работает но с привязкой к столбцу а не к именованному столбцу умной таблицы
            ActiveTable = ActiveCell.ListObject.Name 'рабочий

            With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
                .Value = Now ' работает
                .EntireColumn.AutoFit
            End With
        End If
    Next Cell
End Sub

[/vba]

Код

[/vba]Vlaad79

К сообщению приложен файл: kniga1.xlsm (24.6 Kb)

Ответить

СообщениеВ книге 100 листов с одинаковыми по форме умными таблицами. Отличие листов и таблиц только в номере. Наименование столбцов и форматы в умной одинаковые. Задача автоматически заполнить значение времени в именованном "Столце2" при редактировании в ячейке "Столбца1" без указания имени активного листа, или редактируемой умной таблицы (макрос сам должен вычислять и подставлять в формулу имя листа и имя активной таблицы)
С первой частью справился а со второй прошу помочь. Имеющиеся варианты макроса через диапазон A1:A100 и "With Target.Offset(0, 1)" не подходят так как количество столбцов может со временем меняться а названия столбцов в умной таблице точно менять не буду. Также интересует вопрос вычисления с ссылками на 2 ячейки умной таблицы. все вычисления в границах листа-умной таблицы.

[vba]

Код

[/vba]

Автор - Vlaad79
Дата добавления - 24.01.2025 в 20:08

Gustav

Дата: Пятница, 24.01.2025, 23:35 | Сообщение № 2

Группа: Админы

Ранг: Участник клуба

Сообщений: 2823

Репутация: 1190 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Если активная ячейка находится в пределах умной таблицы, то соответствующая ей ячейка колонки "Столбец2" умной таблицы (т.е. ячейка в той же строке рабочего листа) находится на пересечении полной строки активной ячейки и диапазона данных "Столбца2". Можно в коде зафиксировать соответствующий Range (ячейку пересечения), а затем прописать ему (ей) нужное значение, например, так:
[vba]

Код

Sub test()
    Dim rng As Range
    Set rng = Intersect(ActiveCell.EntireRow, ActiveCell.ListObject.ListColumns("Столбец2").DataBodyRange)
    rng.Value = Now
End Sub

[/vba]

P.S. Соответственно, Вашу событийную процедуру из поста №1 можно переписать следующим образом:
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range, rng As Range

    For Each cell In Target.Cells
        If Not Intersect(cell, cell.ListObject.ListColumns("Столбец1").DataBodyRange) Is Nothing Then

            Set rng = Intersect(cell.EntireRow, cell.ListObject.ListColumns("Столбец2").DataBodyRange)
            With rng
                .Value = Now
                .EntireColumn.AutoFit
            End With
        End If
    Next cell

End Sub

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

VBA ссылки на активную ячейку и лист в умной таблицы (Макросы/Sub)

Страница 1 из 1
1