Доброго времени господа! Как возможно средствами VBA определить адрес активной ячейки, а конкретно в примере: если выделить ячейку С4, её адрес должен отобразиться в ячейке J4 и так с каждой ячейкой в диапазоне B1:D16. Данная тема открыта http://www.planetaexcel.ru/forum....acheyki
Доброго времени господа! Как возможно средствами VBA определить адрес активной ячейки, а конкретно в примере: если выделить ячейку С4, её адрес должен отобразиться в ячейке J4 и так с каждой ячейкой в диапазоне B1:D16. Данная тема открыта http://www.planetaexcel.ru/forum....acheykiadamm1603
'Код размещаем в модуле листа, где выделяем ячейки Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub 'Range("b1:d16") - диапазон ячеек, выделение которого мы отслеживаем If Not Intersect(Target, Range("b1:d16")) Is Nothing Then '[j4] - место, куда записываем адрес выделенной ячейки 'Sheets(2).[j4] - ячейка j4 второго листа [j4] = ActiveCell.Address Else 'аналогично (очищаем ячейку с адресом, если выделенная ячейка вне диапазона b1:d16) [j4].ClearContents End If End Sub
[/vba]
adamm1603, так подойдет? [vba]
Код
'Код размещаем в модуле листа, где выделяем ячейки Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub 'Range("b1:d16") - диапазон ячеек, выделение которого мы отслеживаем If Not Intersect(Target, Range("b1:d16")) Is Nothing Then '[j4] - место, куда записываем адрес выделенной ячейки 'Sheets(2).[j4] - ячейка j4 второго листа [j4] = ActiveCell.Address Else 'аналогично (очищаем ячейку с адресом, если выделенная ячейка вне диапазона b1:d16) [j4].ClearContents End If End Sub
Manyasha, В двух словах не объяснить, суть задачи в том, что бы создать отчёт в форме многуровневого выпадающего списка, ссылка http://excel2.ru/article....wnload. Но в данном случае пришлось допиливать формулы так как исходник не предполагает повторов во втором и далее уровнях и предназначен только для одной рабочей строки, а вот как раз макрос мне здесь и поможет. У меня появиться возможность выбора данных, короче там всё сложно для меня, если интересно могу выслать Вам на почту оригинал может у Вас найдётся другое решение!
Manyasha, В двух словах не объяснить, суть задачи в том, что бы создать отчёт в форме многуровневого выпадающего списка, ссылка http://excel2.ru/article....wnload. Но в данном случае пришлось допиливать формулы так как исходник не предполагает повторов во втором и далее уровнях и предназначен только для одной рабочей строки, а вот как раз макрос мне здесь и поможет. У меня появиться возможность выбора данных, короче там всё сложно для меня, если интересно могу выслать Вам на почту оригинал может у Вас найдётся другое решение!adamm1603
Manyasha, (Марина) здравствуйте! У меня опять маленькая проблема, ни как не могу применить данный код на разные ячейки, предположил, что дублем макроса получится, но не выходит. То есть в результате мне надо использовать четыре диапазона и выводить их в четыре ячейки, сможете помочь?
Manyasha, (Марина) здравствуйте! У меня опять маленькая проблема, ни как не могу применить данный код на разные ячейки, предположил, что дублем макроса получится, но не выходит. То есть в результате мне надо использовать четыре диапазона и выводить их в четыре ячейки, сможете помочь?adamm1603
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("b1:d16")) Is Nothing Then [j4] = ActiveCell.Address ElseIf Not Intersect(Target, Range("b19:d34")) Is Nothing Then [j22] = ActiveCell.Address ElseIf Not Intersect(Target, Range("b37:d52")) Is Nothing Then [j40] = ActiveCell.Address End If End Sub
[/vba] файл перевложила
adamm1603, для каждого диапазона продублируйте блок: [vba]
Код
If Not Intersect(Target, Range("b1:d16")) Is Nothing Then [j4] = ActiveCell.Address Else [j4].ClearContents End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("b1:d16")) Is Nothing Then [j4] = ActiveCell.Address ElseIf Not Intersect(Target, Range("b19:d34")) Is Nothing Then [j22] = ActiveCell.Address ElseIf Not Intersect(Target, Range("b37:d52")) Is Nothing Then [j40] = ActiveCell.Address End If End Sub