Подскажите пожалуйста как реализовать такую задачу, на одном листе надо сделать кнопки чтобы вызывать таблицы с другого листа, таблицы надо переносить полностью с формулами и тд
Подскажите пожалуйста как реализовать такую задачу, на одном листе надо сделать кнопки чтобы вызывать таблицы с другого листа, таблицы надо переносить полностью с формулами и тдandreika21
Я смотрел по поиску похожее есть но там все больше данные переносят, а мне надо полностью таблицу, а без макрокоманд никак не выйдет, я в макросе зеленый огуречик
Я смотрел по поиску похожее есть но там все больше данные переносят, а мне надо полностью таблицу, а без макрокоманд никак не выйдет, я в макросе зеленый огуречикandreika21
Выкладываю полностью таблицы от первого файла они отличаются только количеством строчек, таблицы отличаются только количеством измерений 3, 5, 7 а формулы все идентичные, и надо чтобы я набрал класс точности например 4 а у меня в таблице появились три строчки или появилась таблица с 3 точками, класс точность 1,5 появилась таблица с 5 строчками как то так
Выкладываю полностью таблицы от первого файла они отличаются только количеством строчек, таблицы отличаются только количеством измерений 3, 5, 7 а формулы все идентичные, и надо чтобы я набрал класс точности например 4 а у меня в таблице появились три строчки или появилась таблица с 3 точками, класс точность 1,5 появилась таблица с 5 строчками как то такandreika21
Подкорректировал файл написал там что должно выйти, более подробно не выходит не помещаюсь по размеру 100кб, я надеюсь может можно одолеть это дело без макросов
Подкорректировал файл написал там что должно выйти, более подробно не выходит не помещаюсь по размеру 100кб, я надеюсь может можно одолеть это дело без макросовandreika21
Посмотрите еще решение, без кнопок. Макрос в модуле листа [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "C2" Then Macros End Sub
[/vba] Макрос в Модуле1 [vba]
Код
Sub Macros() Dim i As Long, i1 As Long, i2 As Long Application.ScreenUpdating = False For i = 1 To Sheets("Лист2").Range("A" & Rows.Count).End(xlUp).Row If Sheets("Лист1").Range("C2") = "-" Then Range("A4:BE1000").Clear: Exit Sub If Sheets("Лист2").Range("A" & i) = Sheets("Лист1").Range("C2") Then i1 = i If Sheets("Лист2").Range("A" & i + 1) <> "" And i1 <> 0 Then i2 = i: Exit For Next i If i2 = Empty Then i2 = 1000 Set myRange = Worksheets("Лист2").Range("A" & i1 & ":BE" & i2) Range("A4:BE1000").Clear myRange.Copy (Sheets("Лист1").Range("A4")) Application.ScreenUpdating = True End Sub
[/vba] В ячейке С2 динамический выпадающий список. Список расположен на Лист3. Его можно добавлять и убавлять. Выполнение макросов в должно быть разрешено в настройках безопасности Эксель. Как пользоваться. Выбрать Класс точности в выпадающем списке.
Посмотрите еще решение, без кнопок. Макрос в модуле листа [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "C2" Then Macros End Sub
[/vba] Макрос в Модуле1 [vba]
Код
Sub Macros() Dim i As Long, i1 As Long, i2 As Long Application.ScreenUpdating = False For i = 1 To Sheets("Лист2").Range("A" & Rows.Count).End(xlUp).Row If Sheets("Лист1").Range("C2") = "-" Then Range("A4:BE1000").Clear: Exit Sub If Sheets("Лист2").Range("A" & i) = Sheets("Лист1").Range("C2") Then i1 = i If Sheets("Лист2").Range("A" & i + 1) <> "" And i1 <> 0 Then i2 = i: Exit For Next i If i2 = Empty Then i2 = 1000 Set myRange = Worksheets("Лист2").Range("A" & i1 & ":BE" & i2) Range("A4:BE1000").Clear myRange.Copy (Sheets("Лист1").Range("A4")) Application.ScreenUpdating = True End Sub
[/vba] В ячейке С2 динамический выпадающий список. Список расположен на Лист3. Его можно добавлять и убавлять. Выполнение макросов в должно быть разрешено в настройках безопасности Эксель. Как пользоваться. Выбрать Класс точности в выпадающем списке.AlexM
При открытии файла в Эксель происходит ошибка. В восстановленном файле макрос удален. Вопросы вижу и постараюсь ответить. На вопросы ответил в вашем файле. Макрос в него вставил. Если будут вопросы обращайтесь
При открытии файла в Эксель происходит ошибка. В восстановленном файле макрос удален. Вопросы вижу и постараюсь ответить. На вопросы ответил в вашем файле. Макрос в него вставил. Если будут вопросы обращайтесьAlexM
Попробывал посмотреть макрос а там такое штирлиц отдыхает как это дело в англиский перевести
[vba]
Код
Sub Macros() ' Ēąćīėīāīź ģąźšīńą Dim i As Long, i1 As Long, i2 As Long ' Īļčńąķčå ļåšåģåķķūõ Application.ScreenUpdating = False ' Īņźėž÷åķčå īįķīāėåķč˙ żźšąķą If Sheets("Lapas1").Range("C6") = "-" Then Range("A14:BE1000").Clear: Exit Sub
[/vba]
Попробывал посмотреть макрос а там такое штирлиц отдыхает как это дело в англиский перевести
[vba]
Код
Sub Macros() ' Ēąćīėīāīź ģąźšīńą Dim i As Long, i1 As Long, i2 As Long ' Īļčńąķčå ļåšåģåķķūõ Application.ScreenUpdating = False ' Īņźėž÷åķčå īįķīāėåķč˙ żźšąķą If Sheets("Lapas1").Range("C6") = "-" Then Range("A14:BE1000").Clear: Exit Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "C6" Then Macros '"С6" - ячейка с выпадающим списком End Sub
[/vba] Код в Модуле1 [vba]
Код
Sub Macros() ' Заголовок макроса Dim i As Long, i1 As Long, i2 As Long ' Описание переменных Application.ScreenUpdating = False ' Отключение обновления экрана If Sheets("Lapas1").Range("C6") = "-" Then Range("A14:BE1000").Clear: Exit Sub ' Если в ячейке "С6" выпадающего списка "-" очищаем диапазон ячеек A14:BE1000 For i = 1 To Sheets("Lapas2").Range("A" & Rows.Count).End(xlUp).Row ' Цикл по ячейкам столбца А на Lapas2 по последней заполненной , т.е. до А78 If Sheets("Lapas2").Range("A" & i) = Sheets("Lapas1").Range("C6") Then i1 = i ' Если в значение в ячейке совпадет со значением в выпадающем списке, запоминаем строку начала таблицы If Sheets("Lapas2").Range("A" & i + 1) <> "" And i1 <> 0 Then i2 = i: Exit For ' Это условие выполняется когда определена строка начала таблицы, при этом запоминаем строку конца таблицы Next i ' Конец цикла по столбцу А If i2 = Empty Then i2 = 1000 ' Если конец таблицы не определен (у последней), то считаем конец на 1000 строке Range("A14:BE1000").Clear ' Очищаем диапазон ячеек A14:BE1000 перед вставкой новой таблицы Worksheets("Lapas2").Range("A" & i1 & ":BE" & i2).Copy (Sheets("Lapas1").Range("A14")) ' Копируем диапазон ячеек с таблицей установленной в выпадающем списке Application.ScreenUpdating = True ' Включение обновления экрана End Sub ' Конец макроса
[/vba]
Да уж. Смотрите тогда в спойлере
Код в модуле листа [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "C6" Then Macros '"С6" - ячейка с выпадающим списком End Sub
[/vba] Код в Модуле1 [vba]
Код
Sub Macros() ' Заголовок макроса Dim i As Long, i1 As Long, i2 As Long ' Описание переменных Application.ScreenUpdating = False ' Отключение обновления экрана If Sheets("Lapas1").Range("C6") = "-" Then Range("A14:BE1000").Clear: Exit Sub ' Если в ячейке "С6" выпадающего списка "-" очищаем диапазон ячеек A14:BE1000 For i = 1 To Sheets("Lapas2").Range("A" & Rows.Count).End(xlUp).Row ' Цикл по ячейкам столбца А на Lapas2 по последней заполненной , т.е. до А78 If Sheets("Lapas2").Range("A" & i) = Sheets("Lapas1").Range("C6") Then i1 = i ' Если в значение в ячейке совпадет со значением в выпадающем списке, запоминаем строку начала таблицы If Sheets("Lapas2").Range("A" & i + 1) <> "" And i1 <> 0 Then i2 = i: Exit For ' Это условие выполняется когда определена строка начала таблицы, при этом запоминаем строку конца таблицы Next i ' Конец цикла по столбцу А If i2 = Empty Then i2 = 1000 ' Если конец таблицы не определен (у последней), то считаем конец на 1000 строке Range("A14:BE1000").Clear ' Очищаем диапазон ячеек A14:BE1000 перед вставкой новой таблицы Worksheets("Lapas2").Range("A" & i1 & ":BE" & i2).Copy (Sheets("Lapas1").Range("A14")) ' Копируем диапазон ячеек с таблицей установленной в выпадающем списке Application.ScreenUpdating = True ' Включение обновления экрана End Sub ' Конец макроса