Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Показ определенного диапазона документа
 
#1
24.08.2017 02:02:55
здравствуйте, в файле будет много таблиц как в листе 2, все они разные по наполнению но имеют одинаковый размер, Есть ли возможность в екселе сделать так, что бы к примеру на 1 страничке когда я кликаю на таблица 1 в строке список, ее показывало в области показа.
 
 
 
#2
24.08.2017 02:28:32
lifesss,Здравствуйте, если вам только посмотреть, а не вносить изменения. Посмотрите пример. В B2 выпадающих список, выбираете имя таблицы которую хотите вывести.
 
 
 
#3
24.08.2017 03:58:29
Александр П., cпасибо, а можно реализовать через клик по названию, например нажимаю таблица 1 и она появляется? редактировать таблицы не нужно они только для просмотра
 
 
 
#4
24.08.2017 04:17:36
lifesss, Можно и так.
 
 
 
#5
24.08.2017 04:24:00
Александр П., То что нужно, теперь осталось понять как это сделать
 
 
 
#6
24.08.2017 04:49:14
lifesss, нажимаете alt+F11 , открываете модуль листа на котором у вас располагается эта область показа, вставляете код.
Код
Public TableName
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(1)) Is Nothing Then 'меняете номер столбца на тот в котором у вас расположен список с названиями таблиц
    If Target.Value <> "" And Target.Address <> "$A$1" Then TableName = Target.Value: CopyTable '$A$1 - меняете адрес ячейки в котором расположен заголовок списка с названиями таблиц на ваш
End If
End Sub
Sub CopyTable()
Application.ScreenUpdating = False
On Error GoTo metka
With Sheets(2) 'меняете номер листа на котором расположены ваши таблицы
    RwsTable = .Cells.Find(What:=TableName, LookAt:=xlWhole).Row + 1
    .Range("B" & RwsTable & ":N" & RwsTable + 12).Copy [H3]: Exit Sub '[H3] - первая ячейка диапазона "показа", меняем на свою.
End With
metka: If Err Then MsgBox "Таблицы под названием " & TableName & " не существует"
Application.ScreenUpdating = True
End Sub
Читайте комментарии, правьте под свои данные
 
 
 
#7
24.08.2017 04:50:36
Александр П.,Огромное спасибо
 
 
 
#8
24.08.2017 08:02:10
Александр П., Как добавлять новые таблички понял, все очень удобно, вот только не понял как добавить еще список и что бы он брал таблички с другого листа так и не смог понять  
 
 
 
#9
24.08.2017 08:35:26
lifesss, Немного непонятно, у вас много листов с такими таблицами?
 
 
 
#10
24.08.2017 08:51:48
Александр П., в принципе я могу все таблицы и в 1 лист запихнуть, главное что бы кнопки не в 1 рядок были, а в 9 рядков, как а файле сбросил
 
 
 
#11
24.08.2017 09:16:45
lifesss,замените
Код
If Not Intersect(Target, Columns(1)) Is Nothing Then
на
Код
If Not Intersect(Target, Range("A2:I7")) Is Nothing Then
и из следующей строки уберите
Код
And Target.Address <> "$A$1"
Но если все таблицы будут располагаться на 1ом листе у них у всех должны быть разные названия, не должно быть 9 таблиц - "Таблица 1" и т.д.
Изменено: Александр П. - 24.08.2017 09:17:22
 
 
 
#12
24.08.2017 17:59:05
Александр П., сейчас код у меня выглядит так.
Код
Public TableName
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:A7")) Is Nothing Then
    If Target.Value <> "" Then TableName = Target.Value: CopyTable
End If
End Sub
Sub CopyTable()
Application.ScreenUpdating = False
On Error GoTo metka
With Sheets(2)
    RwsTable = .Cells.Find(What:=TableName, LookAt:=xlWhole).Row + 1
    .Range("B" & RwsTable & ":N" & RwsTable + 12).Copy [K3]: Exit Sub
End With
metka: If Err Then MsgBox "íå íàéäåíà " & TableName & ""
Application.ScreenUpdating = True
End Sub
что дописать что бы:
B2:B7 брали таблицы из листа 3,
С2:C7 брали таблицы из листа 4, и так далее до I2:I7
Изменено: lifesss - 24.08.2017 18:08:36
 
 
 
#13
25.08.2017 00:07:44
в принципе выкрутился добавлением 1.1 к названиям таблиц  
 
 
 
#14
25.08.2017 01:57:28
lifesss,Вчера не было времени ответить. Предлагаю так тогда, заголовок списка - название листа с которого берем таблицу.
Код
Public TableName, ShName
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:I7")) Is Nothing Then
    If Target.Value <> "" And Target.Address <> "$A$1" Then ShName = Cells(1, Target.Column): TableName = Target.Value: CopyTable
End If
End Sub
Sub CopyTable()
Application.ScreenUpdating = False
On Error GoTo metka
With Sheets(ShName)
    RwsTable = .Cells.Find(What:=TableName, LookAt:=xlWhole).Row + 1
    .Range("B" & RwsTable & ":N" & RwsTable + 12).Copy [K3]: Exit Sub
End With
metka: If Err Then MsgBox "Таблицы под названием " & TableName & " не существует"
Application.ScreenUpdating = True
End Sub
 
 
 
Страницы: 1
Наверх