Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 След.
Ссылка на другой лист в формуле УФ если название листа указано в ячейке
 
То, что надо! Благодарю за помощь!
Ссылка на другой лист в формуле УФ если название листа указано в ячейке
 
Как в формуле УФ обратиться к листу, если название листа отображено в ячейке?
В формуле 'название листа'! - работает, а 'ячейка с названием' ! - ошибка.
Бекап/Импорт отдельных нескольких листов книги
 
Я пробовал так как вы показали, но выскакивает ошибка переменная не определена. Почему так, не смог разобраться.
Файл с "исправленным" кодом приложил.
Бекап/Импорт отдельных нескольких листов книги
 
Может кому будет интересно, так сработало:
Код
Sub Import()
Application.ScreenUpdating = False
Dim wsSh, i$
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        ThisWorkbook.Sheets(Array(2, 3, 4)).Delete
        GetObject(i).Sheets(Array(1, 2, 3)).Copy After:=ThisWorkbook.Sheets(1)
        GetObject(i).Close
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        ThisWorkbook.Sheets(1).Activate
        MsgBox "Imported!", 64, "Import"
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub
Изменено: OSA913 - 19 май 2020 06:00:33
Бекап/Импорт отдельных нескольких листов книги
 
Бекап работает, сделал так:
Код
Sub Backup()
Application.ScreenUpdating = False
Dim wsSh, FileName$
If MsgBox("Backup?", vbQuestion + vbYesNo, "Backup") = vbNo Then
        Exit Sub
    Else
        For Each wsSh In Array(2, 3, 4)
            Sh_Unprotect Application.ThisWorkbook.Sheets(wsSh)
        Next
        On Error Resume Next
        FileName = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty)
        If FileName = "False" Then GoTo Ex
        Err.Clear: ThisWorkbook.Sheets(Array(2, 3, 4)).Copy: DoEvents
        If Err Then GoTo Ex
        If ActiveWorkbook.Worksheets.Count = 3 And ActiveWorkbook.Path = "" Then
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            ActiveWorkbook.SaveAs FileName, xlOpenXMLWorkbook
            ActiveWorkbook.DisplayAlerts = True
            Application.EnableEvents = True
            ActiveWorkbook.Close False
            If Err = 1004 Then GoTo Ex
            MsgBox "Created!", 64, "Backup"
        End If
    End If
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True
End Sub


Импорт сделал так:
Код
Sub Import()
Application.ScreenUpdating = False
Dim wsSh, i$, j&, k&, l As Byte
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        For Each wsSh In Array(2, 3, 4)
            Sh_Unprotect Application.ThisWorkbook.Sheets(wsSh)
        Next
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        For l = 2 To 4
            j = ThisWorkbook.Sheets(l).UsedRange.Rows.Count + 1
            k = GetObject(i).Sheets(l - 1).UsedRange.Rows.Count + 1
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            GetObject(i).Sheets(l - 1).Range(Cells(2, 1), Cells(k, 197)).Copy
            Application.DisplayAlerts = True
            Application.EnableEvents = True
            ThisWorkbook.Sheets(l).Activate
            ThisWorkbook.Sheets(l).Range(Cells(2, 1), Cells(j, 197)).ClearContents
            ThisWorkbook.Sheets(l).Range("A2").Select: ActiveSheet.Paste
            l = l + 1
        Next l
        GetObject(i).Close
        ThisWorkbook.Sheets(1).Activate
        Application.Caption = IIf(False = True, Empty, "")
        Application.DisplayStatusBar = False
        MsgBox "Imported!", 64, "Import"
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub

Но при импорте если убрать обработчик ошибок, получаю ошибку  1004 "Метод Paste из класса Worksheet завершен неверно". Если после строки
Код
GetObject(i).Sheets(l - 1).Range(Cells(2, 1), Cells(k, 197)).Copy

закрыть файл (GetObject(i).Close), тогда "Paste" работает, но если закрыть в конце цикла, тогда ошибка. А нужно закрыть в конце цикла чтобы скопировались все листы. Как поправить этот момент? Обновленный файл пример приложил.
Бекап/Импорт отдельных нескольких листов книги
 
Здравствуйте, в книге 4 листа, у меня есть код, который сохраняет и импортит только 1 лист из книги. Помогите поправить код, что бы был бекап и так же импорт 3х последних листов с сохранением названий этих листов. Файл пример приложил.
Код:
Код
Sub Backup()
Application.ScreenUpdating = False
Dim FileName$
If MsgBox("Backup?", vbQuestion + vbYesNo, "Backup") = vbNo Then
        Exit Sub
    Else
        Application.ThisWorkbook.Sheets(2).Unprotect ("")
        On Error Resume Next
        FileName = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty)
        If FileName = "False" Then GoTo Ex
        Err.Clear: ThisWorkbook.Sheets(2).Copy: DoEvents
        If Err Then GoTo Ex
        If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            ActiveWorkbook.SaveAs FileName, xlOpenXMLWorkbook
            ActiveWorkbook.DisplayAlerts = True
            Application.EnableEvents = True
            ActiveWorkbook.Close False
            If Err = 1004 Then GoTo Ex
            MsgBox "Created!", 64, "Backup"
        End If
    End If
Ex: Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub

Sub Import()
Application.ScreenUpdating = False
Dim i$, j&, k&
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        Application.ThisWorkbook.Sheets(2).Unprotect ("")
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        j = ThisWorkbook.Sheets(2).UsedRange.Rows.Count + 1
        k = GetObject(i).Sheets(1).UsedRange.Rows.Count + 1
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        GetObject(i).Sheets(1).Range(Cells(2, 1), Cells(k, 197)).Copy: GetObject(i).Close
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        ThisWorkbook.Sheets(2).Activate
        ThisWorkbook.Sheets(2).Range(Cells(2, 1), Cells(j, 197)).ClearContents
        ThisWorkbook.Sheets(2).Range("A2").Select: ActiveSheet.Paste
        ThisWorkbook.Sheets(1).Activate
        Application.Caption = IIf(False = True, Empty, "")
        Application.DisplayStatusBar = False
        MsgBox "Imported!", 64, "Import"
Ex:         Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True: ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub
Вызвать макрос при изменении ячеек
 
Придумал. Всех благодарю за помощь!
Вызвать макрос при изменении ячеек
 
Чтобы в объединённых работало удаление можно что нибудь придумать?
Вызвать макрос при изменении ячеек
 
из-за того что ячейки объединены
Вызвать макрос при изменении ячеек
 
Не понятно по какой причине в примере работает на удаление значения, а в рабочем файле нет.
Вызвать макрос при изменении ячеек
 
skais675, спасибо, а как сделать чтобы макрос сработал при удалении значения? может как то можно условие добавить?
Заполнить отдельные элементы VBA массива одним значением
 
Да, цикл подойдёт. Спасибо.

Цитата
БМВ написал:
OSA913 , Вы хоть тайну откройте, в чем идея?
Просто хотел уточнить.
Вызвать макрос при изменении ячеек
 
Здравствуйте, помогите с кодом. Нужно чтобы при изменении значения в определённой ячейки в диапазоне срабатывал определённый макрос, и так же чтобы макрос срабатывал когда значение в ячейке удаляется delete-ом.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Union(Cells(2, 37), Range(Cells(4, 38), Cells(16, 38)))) Is Nothing Then
    Select Case Range
        Case Cells(2, 37)
            Call Макрос1
        Case Cells(4, 38)
            Call Макрос2           
        Case Cells(5, 38)
            Call Макрос3
        Case Cells(6, 38)
            Call Макрос4
    End Select
End If
End Sub
Заполнить отдельные элементы VBA массива одним значением
 
Есть ли какая нибудь функция типа Union для диапазонов листа, только для элементов VBA массива?
Задача заполнить отдельные элементы массива одним значением в одной строке кода.
Назначить горячую клавишу только Ctrl
 
Благодарю за развернутый ответ. Решил оставить все как есть.

Цитата
Дмитрий(The_Prist) Щербаков написал:
Зачем эти все заморочки с кнопочками в каждой ячейке? Что за тяга к созданию себе любимому сложностей?
Кнопочки на защищенном листе защищают ячейки от случайного изменения пользователем значениий в ячейках, что приведет к ошибкам при выполнении некоторых макросов.
Изменено: OSA913 - 24 янв 2020 20:51:31
Назначить горячую клавишу только Ctrl
 
Ну как бы я хочу не совсем назначить на нее макрос а отключать ее на время выполнения макроса. На листе есть таблица, каждая ячейка в ней-кнопка с макросом, который закрашивает эту ячейку. Задача - чтобы при нажатии кнопки в то время как нажат Ctrl окрашивалась не только одна ячейка, а часть диапазона. Задача эта реализована только с кнопкой Tab, а если в место Tab назначить Ctrl, то при наведении на кнопку с макросом и нажатии Ctrl курсор меняется на стрелку вместо указательного пальца и нажать на кнопку с макросом становится не возможным. Поэтому надо что бы только в данной книге Ctrl не выполнял свою предназначенную excel функцию. он в этой книге вообще не нужен кроме как определять событие этой кнопки.
Назначить горячую клавишу только Ctrl
 
Можно назначить макрос только на кнопку контрол? Этим способом:
Код
Private Sub Workbook_Open()
Application.OnKey "{^}", "Макрос"
End Sub

не работает. Подозреваю что кнопку надо как то назначать через WinApi.
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Игорь спасибо за файл, но когда я ввожу в В2 значение, которого нет в Е:Е, ячейка не зеленеет. Это можно исправить добавив в нее второе правило с формулой:
Код
=ЕНД(ПОИСКПОЗ(B2;E:E;))

Но так будет уже два УФ правила на одной ячейке, вопрос можно ли соединить эти формулы, так чтобы они были в одном правиле УФ, и ячейка зеленела когда значения в найденном диапазоне совпадают и когда значение не доступно (Н/Д)?
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
"Изменить цвет ячейки если диапазон состоит из определенных значений, или если  значение не доступно (Ошибка #Н/Д)"
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Не могли бы вы приложить файл где есть ячейка с УФ с этим правилом
Формула УФ - если в диапазоне присутствуют только некоторые значения
 
Т.е. только могу вводить эту длинную формулу с тремя "СЧЁТЕСЛИМН", нельзя сократить ее как у Игоря, и чтобы она подошла для УФ?
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Хочу первую и вторую формулу вставить в одно правило УФ, чтобы ячейка меняла цвет когда выполняется условие первой формулы или условие второй (ошибка: Н/Д). У меня только работает когда для каждой формулы отдельное правило.
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Я пробовал с ИЛИ, ЕСЛИОШИБКА и еще с чем то - не дало результата. Премного Благодарен!

Все равно не срабатывает УФ в B4, когда Н/Д
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Пример
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
Есть две формулы в двух правилах УФ:
Код
=СУММ(СЧЁТЕСЛИМН(ИНДЕКС($F:$K;ПОИСКПОЗ(B2;E:E;););1;ИНДЕКС($F:$K;ПОИСКПОЗ(B2;E:E;););2;ИНДЕКС($F:$K;ПОИСКПОЗ(B2;E:E;););""))=6
,
Код
=ЕНД(ПОИСКПОЗ(B2;E:E;))

Можно ли эти формулы объединить в одну, чтобы было одно правило в место двух? Как бы это сделать?
Получить адрес диапазона ячеек в формуле
 
То что нужно Спасибо.
Формула УФ - если в диапазоне присутствуют только некоторые значения
 
Для УФ формула с массивом не подходит.
Получить адрес диапазона ячеек в формуле
 
В ячейке B4 нужно подсчитать количество единичек в диапазоне. В файле-примере нужно значение B2 ("qqq") найти в первой колонке таблицы, затем получить диапазон, который находится в этой же стоке что и ячейка с этим значением, смещенный на один столбец вправо и имеющий 6 ячеек и подсчитать ячейки с "1" в этом диапазоне. В примере этот диапазон "F6:K6". Как это реализовать в формуле?
Формула УФ - если в диапазоне присутствуют только некоторые значения
 
Приветствую Вас. В ячейках указанного диапазона могут быть разные значения. Для УФ нужно чтобы в этом диапазоне присутствовали только эти 3 значения или любые сочетания из этих значений, или одно, два из этих значений. Если в диапазоне будет хотя бы одно другое значение, то условие не выполняется.  Пока подобрал такую формулу:
Код
=СУММ(СЧЁТЕСЛИМН(B1:J1;1);СЧЁТЕСЛИМН(B1:J1;2);СЧЁТЕСЛИМН(B1:J1;""))=9
Формула УФ - если в диапазоне присутствуют только некоторые значения
 
Здравствуйте. Помогите с формулой для УФ.
Если в диапазоне B1:J1 есть только значения "", 1, 2, тогда ячейка A1 меняет цвет.
Страницы: 1 2 3 4 5 6 7 8 9 След.
Наверх