В книге 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]
В книге 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
Если активная ячейка находится в пределах умной таблицы, то соответствующая ей ячейка колонки "Столбец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]
Если активная ячейка находится в пределах умной таблицы, то соответствующая ей ячейка колонки "Столбец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
Gustav, Спасибо за ответ. Код работает только на 1 странице, скопировал код на др. листы, но при запуске на др. листах выдает ошибку в строке 9 "subscript out of range". Необходим код для работы именно с активной умной таблицей на активном листе. задумка была в следующем: Макрос должен сам определять имя активного листа и активной умной таблицы, делать его диапазоном и проводить вычисления именно с привязкой к активной таблице и только при необходимости в ручную прописываются ссылки на умные таблицы - путь названия листа. Так же прощу подсказать как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.
Gustav, Спасибо за ответ. Код работает только на 1 странице, скопировал код на др. листы, но при запуске на др. листах выдает ошибку в строке 9 "subscript out of range". Необходим код для работы именно с активной умной таблицей на активном листе. задумка была в следующем: Макрос должен сам определять имя активного листа и активной умной таблицы, делать его диапазоном и проводить вычисления именно с привязкой к активной таблице и только при необходимости в ручную прописываются ссылки на умные таблицы - путь названия листа. Так же прощу подсказать как сделать чтобы после удаления значения в исходной ячейке (Столбец1) очищалась и зависимая (вычисляемая) - Столбец2.Vlaad79
Ну, так ёлка-палка! Вы же название первой колонки на остальных листах изменили: вместо "Столбец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 на отдельных листах.
Ну, так ёлка-палка! Вы же название первой колонки на остальных листах изменили: вместо "Столбец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
как сделать чтобы после удаления значения в исходной ячейке (Столбец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] Я добавил строку проверки нахождения текущей ячейки внутри умной таблицы - чтобы при изменении ячеек за пределами умной таблицы не возникали ошибки.
как сделать чтобы после удаления значения в исходной ячейке (Столбец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
Если есть возможность прошу пояснить почему не работала строка из начального кода With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
Вопрос интересует потому что не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы. Пример если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5" или "0"
Вопрос как прописать этот путь к "умной" ячейке в коде?
Спасибо огромное. Все работает.
Если есть возможность прошу пояснить почему не работала строка из начального кода With Range((WsS.ActiveTable & "[Столбец2]") & Cell.Row) ' не работает ?????
Вопрос интересует потому что не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы. Пример если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5" или "0"
Вопрос как прописать этот путь к "умной" ячейке в коде?Vlaad79
Если есть возможность прошу пояснить почему не работала строка из начального кода 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 - смещение строки начала данных колонки от первой строки
Если есть возможность прошу пояснить почему не работала строка из начального кода 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 - смещение строки начала данных колонки от первой строки
не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы
Надо потратить немного предварительных усилий и заготовить объектные переменные (типа 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)
если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5"
не нашел кода к прямому обращения (запроса) к определенной ячейки умной таблицы
Надо потратить немного предварительных усилий и заготовить объектные переменные (типа 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)
если значение ячейки столбца "column1" умной таблицы "TAB1" на листе "List1" равно значение ячейки столбца "column2" умной таблицы "TAB1" на листе "List1" то в ячейке столбца "column3" умной таблицы "TAB1" на листе "List1" присваивается значение "5"
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
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