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

Вход

Регистрация

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

 

= Мир MS Excel/VBA ссылки на активную ячейку и лист в умной таблицы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
VBA ссылки на активную ячейку и лист в умной таблицы
Vlaad79 Дата: Пятница, 24.01.2025, 20:08 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 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]
К сообщению приложен файл: kniga1.xlsm (24.6 Kb)
 
Ответить
СообщениеВ книге 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]

Автор - Vlaad79
Дата добавления - 24.01.2025 в 20:08
Gustav Дата: Пятница, 24.01.2025, 23:35 | Сообщение № 2
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 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
 
Ответить
СообщениеЕсли активная ячейка находится в пределах умной таблицы, то соответствующая ей ячейка колонки "Столбец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]

Автор - Gustav
Дата добавления - 24.01.2025 в 23:35
Vlaad79 Дата: Суббота, 25.01.2025, 11:20 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Gustav, Спасибо за ответ.
Код работает только на 1 странице, скопировал код на др. листы, но при запуске на др. листах выдает ошибку в строке 9 "subscript out of range".
Необходим код для работы именно с активной умной таблицей на активном листе. задумка была в следующем: Макрос должен сам определять имя активного листа и активной умной таблицы, делать его диапазоном и проводить вычисления именно с привязкой к активной таблице и только при необходимости в ручную прописываются ссылки на умные таблицы - путь названия листа.
Так же прощу подсказать как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.
К сообщению приложен файл: kniga1_1.xlsm (27.5 Kb)
 
Ответить
СообщениеGustav, Спасибо за ответ.
Код работает только на 1 странице, скопировал код на др. листы, но при запуске на др. листах выдает ошибку в строке 9 "subscript out of range".
Необходим код для работы именно с активной умной таблицей на активном листе. задумка была в следующем: Макрос должен сам определять имя активного листа и активной умной таблицы, делать его диапазоном и проводить вычисления именно с привязкой к активной таблице и только при необходимости в ручную прописываются ссылки на умные таблицы - путь названия листа.
Так же прощу подсказать как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.

Автор - Vlaad79
Дата добавления - 25.01.2025 в 11:20
Gustav Дата: Суббота, 25.01.2025, 13:01 | Сообщение № 4
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Код работает только на 1 странице

Ну, так ёлка-палка! Вы же название первой колонки на остальных листах изменили: вместо "Столбец1" сделали "ver0". Если хотите проверять именно первую колонку умной таблицы, как бы она ни называлась, то надо перейти от текстового названия к числовому индексу. Сделайте замену одной строки в коде:
с такой:
[vba]
Код
If Not Intersect(cell, cell.ListObject.ListColumns("Столбец1").DataBodyRange) Is Nothing Then
[/vba]
на такую:
[vba]
Код
If Not Intersect(cell, cell.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
[/vba]
и будет Вам счастье на всех листах, в которые Вы вставите этот код.

И, кстати! Чтобы держать такую однотипную для всех листов процедуру в одном месте, без необходимости размножения по количеству листов - надо просто поместить ее в обработку события Workbook_SheetChange уровня рабочей книги (заметьте - без изменений! что уже говорит о ее могучей универсальности, без необходимости получения имени конкретного рабочего листа):

[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, 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]
И это "одно место" теперь будет обслуживать все листы рабочей книги. Проверьте! Только не забудьте перед этим удалить (или хотя бы закомментировать) процедуры Worksheet_Change на отдельных листах.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
Код работает только на 1 странице

Ну, так ёлка-палка! Вы же название первой колонки на остальных листах изменили: вместо "Столбец1" сделали "ver0". Если хотите проверять именно первую колонку умной таблицы, как бы она ни называлась, то надо перейти от текстового названия к числовому индексу. Сделайте замену одной строки в коде:
с такой:
[vba]
Код
If Not Intersect(cell, cell.ListObject.ListColumns("Столбец1").DataBodyRange) Is Nothing Then
[/vba]
на такую:
[vba]
Код
If Not Intersect(cell, cell.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
[/vba]
и будет Вам счастье на всех листах, в которые Вы вставите этот код.

И, кстати! Чтобы держать такую однотипную для всех листов процедуру в одном месте, без необходимости размножения по количеству листов - надо просто поместить ее в обработку события Workbook_SheetChange уровня рабочей книги (заметьте - без изменений! что уже говорит о ее могучей универсальности, без необходимости получения имени конкретного рабочего листа):

[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, 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]
И это "одно место" теперь будет обслуживать все листы рабочей книги. Проверьте! Только не забудьте перед этим удалить (или хотя бы закомментировать) процедуры Worksheet_Change на отдельных листах.

Автор - Gustav
Дата добавления - 25.01.2025 в 13:01
Gustav Дата: Суббота, 25.01.2025, 13:15 | Сообщение № 5
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.

[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim cell As Range, rng As Range
    
    For Each cell In Target.Cells
        If cell.ListObject Is Nothing Then Exit For 'проверка вхождения ячейки в умную таблицу
        
        If Not Intersect(cell, cell.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
        
            Set rng = Intersect(cell.EntireRow, cell.ListObject.ListColumns("Столбец2").DataBodyRange)
            With rng
                If IsEmpty(cell) Then
                    .ClearContents 'очистка ячейки в Столбце2 при очистке ячейки в Столбце1
                Else
                    .Value = Now
                    .EntireColumn.AutoFit
                End If
            End With
        End If
    Next cell

End Sub
[/vba]
Я добавил строку проверки нахождения текущей ячейки внутри умной таблицы - чтобы при изменении ячеек за пределами умной таблицы не возникали ошибки.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.

[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim cell As Range, rng As Range
    
    For Each cell In Target.Cells
        If cell.ListObject Is Nothing Then Exit For 'проверка вхождения ячейки в умную таблицу
        
        If Not Intersect(cell, cell.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
        
            Set rng = Intersect(cell.EntireRow, cell.ListObject.ListColumns("Столбец2").DataBodyRange)
            With rng
                If IsEmpty(cell) Then
                    .ClearContents 'очистка ячейки в Столбце2 при очистке ячейки в Столбце1
                Else
                    .Value = Now
                    .EntireColumn.AutoFit
                End If
            End With
        End If
    Next cell

End Sub
[/vba]
Я добавил строку проверки нахождения текущей ячейки внутри умной таблицы - чтобы при изменении ячеек за пределами умной таблицы не возникали ошибки.

Автор - Gustav
Дата добавления - 25.01.2025 в 13:15
Vlaad79 Дата: Пятница, 31.01.2025, 09:27 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

hands Спасибо огромное. Все работает.

Если есть возможность прошу пояснить почему не работала строка из начального кода
With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????

Вопрос интересует потому что не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы.
Пример если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5" или "0"

Вопрос как прописать этот путь к "умной" ячейке в коде?
 
Ответить
Сообщениеhands Спасибо огромное. Все работает.

Если есть возможность прошу пояснить почему не работала строка из начального кода
With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????

Вопрос интересует потому что не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы.
Пример если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5" или "0"

Вопрос как прописать этот путь к "умной" ячейке в коде?

Автор - Vlaad79
Дата добавления - 31.01.2025 в 09:27
Gustav Дата: Пятница, 31.01.2025, 13:57 | Сообщение № 7
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Если есть возможность прошу пояснить почему не работала строка из начального кода
With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????

Если в двух словах, то, извините, потому что написана чушь. Потому что "смешались в кучу кони люди... рейнджи, стринги...". Вот с такими изменениями в двух строках (найдёте каких у себя) работает:
[vba]
Код
Dim WsS As String '''''Range

'''''With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
With Range("'" & WsS & "'!" & ActiveTable & "[Столбец2]")(Cell.Row - 3) '3 - смещение строки начала данных колонки от первой строки
[/vba]


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
Если есть возможность прошу пояснить почему не работала строка из начального кода
With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????

Если в двух словах, то, извините, потому что написана чушь. Потому что "смешались в кучу кони люди... рейнджи, стринги...". Вот с такими изменениями в двух строках (найдёте каких у себя) работает:
[vba]
Код
Dim WsS As String '''''Range

'''''With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
With Range("'" & WsS & "'!" & ActiveTable & "[Столбец2]")(Cell.Row - 3) '3 - смещение строки начала данных колонки от первой строки
[/vba]

Автор - Gustav
Дата добавления - 31.01.2025 в 13:57
Gustav Дата: Пятница, 31.01.2025, 14:39 | Сообщение № 8
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы

Надо потратить немного предварительных усилий и заготовить объектные переменные (типа Range) для областей данных всех колонок, которыми собираетесь оперировать в последующем коде. Вот примерно так для трех колонок таблицы:
[vba]
Код
Dim col1 As Range, col2 As Range, col3 As Range, r As Long

With ActiveCell.ListObject
    Set col1 = .ListColumns("Столбец1").DataBodyRange
    Set col2 = .ListColumns("Столбец2").DataBodyRange
    Set col3 = .ListColumns("Столбец3").DataBodyRange
End With
[/vba]
И дальше предыдущий фрагмент вашего кода с With Range становится чертовски простым, прозрачным и удобным:
[vba]
Код
'''''With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
'''With Range("'" & WsS & "'!" & ActiveTable & "[Столбец2]")(Cell.Row - 3) '3 - смещение строки начала данных колонки от первой строки
r = Cell.Row - 3
With col2(r)
[/vba]

если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5"

Используя предыдущие заготовки:
[vba]
Код
If col1(r) = col2(r) Then col3(r) = 5
[/vba]


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы

Надо потратить немного предварительных усилий и заготовить объектные переменные (типа Range) для областей данных всех колонок, которыми собираетесь оперировать в последующем коде. Вот примерно так для трех колонок таблицы:
[vba]
Код
Dim col1 As Range, col2 As Range, col3 As Range, r As Long

With ActiveCell.ListObject
    Set col1 = .ListColumns("Столбец1").DataBodyRange
    Set col2 = .ListColumns("Столбец2").DataBodyRange
    Set col3 = .ListColumns("Столбец3").DataBodyRange
End With
[/vba]
И дальше предыдущий фрагмент вашего кода с With Range становится чертовски простым, прозрачным и удобным:
[vba]
Код
'''''With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
'''With Range("'" & WsS & "'!" & ActiveTable & "[Столбец2]")(Cell.Row - 3) '3 - смещение строки начала данных колонки от первой строки
r = Cell.Row - 3
With col2(r)
[/vba]

если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5"

Используя предыдущие заготовки:
[vba]
Код
If col1(r) = col2(r) Then col3(r) = 5
[/vba]

Автор - Gustav
Дата добавления - 31.01.2025 в 14:39
Gustav Дата: Пятница, 31.01.2025, 15:07 | Сообщение № 9
Группа: Админы
Ранг: Участник клуба
Сообщений: 2829
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
With ActiveCell.ListObject
    Set col1 = .ListColumns("Столбец1").DataBodyRange
    Set col2 = .ListColumns("Столбец2").DataBodyRange
    Set col3 = .ListColumns("Столбец3").DataBodyRange
End With

Это можно записать чуть-чуть короче (с переносом .ListColumns в With):
[vba]
Код
With ActiveCell.ListObject.ListColumns
    Set col1 = .Item("Столбец1").DataBodyRange
    Set col2 = .Item("Столбец2").DataBodyRange
    Set col3 = .Item("Столбец3").DataBodyRange
End With
[/vba]
И даже так:
[vba]
Код
With ActiveCell.ListObject.ListColumns
    Set col1 = ![Столбец1].DataBodyRange
    Set col2 = ![Столбец2].DataBodyRange
    Set col3 = ![Столбец3].DataBodyRange
End With
[/vba]


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
With ActiveCell.ListObject
    Set col1 = .ListColumns("Столбец1").DataBodyRange
    Set col2 = .ListColumns("Столбец2").DataBodyRange
    Set col3 = .ListColumns("Столбец3").DataBodyRange
End With

Это можно записать чуть-чуть короче (с переносом .ListColumns в With):
[vba]
Код
With ActiveCell.ListObject.ListColumns
    Set col1 = .Item("Столбец1").DataBodyRange
    Set col2 = .Item("Столбец2").DataBodyRange
    Set col3 = .Item("Столбец3").DataBodyRange
End With
[/vba]
И даже так:
[vba]
Код
With ActiveCell.ListObject.ListColumns
    Set col1 = ![Столбец1].DataBodyRange
    Set col2 = ![Столбец2].DataBodyRange
    Set col3 = ![Столбец3].DataBodyRange
End With
[/vba]

Автор - Gustav
Дата добавления - 31.01.2025 в 15:07
  • Страница 1 из 1
  • 1
Поиск:

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