Доброго времени суток. В 1 модуле Много макросов с MsgBox'ами , ответы да/нет записываются в указаные ячейки, что нужно дописать чтобы при изменение даты в ячейке С3 допустим MsgBox сохранял не в лист.2 ячека Д8 допустим, а в лист 2.ячейка Е8 и тд , или что-то вроде , если значение ячейки С3 совпадает с ячейкой Е7 тогда все ответы сохраняются в Е7-Е8-Е9 и тд? Вот пример моего MsgBox а и так идут они вкучку все
[vba]
Код
Sub Макрос0() ' ' Макрос0 Макрос Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If MsgBox("Программа установилась?", vbYesNo, "Установка") = vbYes Then Sheets("МП").Range("D7").FormulaR1C1 = "Ошибок нет" With Sheets("МП").Range("D7").Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = vbGreen .TintAndShade = 0 .PatternTintAndShade = 0 End With
Else Sheets("МП").Select Range("D7").Select ActiveCell.FormulaR1C1 = "Введите описание ошибки" With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If
End Sub
[/vba]
Помогите пожалуйста уже 3 дня ищу в интернете и не могу найти:(
Доброго времени суток. В 1 модуле Много макросов с MsgBox'ами , ответы да/нет записываются в указаные ячейки, что нужно дописать чтобы при изменение даты в ячейке С3 допустим MsgBox сохранял не в лист.2 ячека Д8 допустим, а в лист 2.ячейка Е8 и тд , или что-то вроде , если значение ячейки С3 совпадает с ячейкой Е7 тогда все ответы сохраняются в Е7-Е8-Е9 и тд? Вот пример моего MsgBox а и так идут они вкучку все
[vba]
Код
Sub Макрос0() ' ' Макрос0 Макрос Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If MsgBox("Программа установилась?", vbYesNo, "Установка") = vbYes Then Sheets("МП").Range("D7").FormulaR1C1 = "Ошибок нет" With Sheets("МП").Range("D7").Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = vbGreen .TintAndShade = 0 .PatternTintAndShade = 0 End With
Else Sheets("МП").Select Range("D7").Select ActiveCell.FormulaR1C1 = "Введите описание ошибки" With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If
End Sub
[/vba]
Помогите пожалуйста уже 3 дня ищу в интернете и не могу найти:(Amon
Sub Макрос0() Dim rCell As Range With Worksheets("МП") 'Пересечение строки 7 и столбца с датой. Для остальных макросов поменять номер строки здесь: .Rows(7) Set rCell = Intersect(.Rows(7), .Cells.Find(Worksheets("1").[c2]).EntireColumn) End With With rCell If MsgBox("Программа установилась?", vbYesNo, "Установка") = vbYes Then .Value = "Ошибок нет" .Interior.Color = vbGreen Else .Value = "Введите описание ошибки" .Interior.Color = 65535 Worksheets("МП").Activate .Select End If End With End Sub
[/vba]
Amon, добрый день. Так хотели? [vba]
Код
Sub Макрос0() Dim rCell As Range With Worksheets("МП") 'Пересечение строки 7 и столбца с датой. Для остальных макросов поменять номер строки здесь: .Rows(7) Set rCell = Intersect(.Rows(7), .Cells.Find(Worksheets("1").[c2]).EntireColumn) End With With rCell If MsgBox("Программа установилась?", vbYesNo, "Установка") = vbYes Then .Value = "Ошибок нет" .Interior.Color = vbGreen Else .Value = "Введите описание ошибки" .Interior.Color = 65535 Worksheets("МП").Activate .Select End If End With End Sub
Скажите пожалуйста, а возможно сделать так чтобы он не найдя соответствие, создавался столбец со сдвигом вправо к примеру и вносил дату проставленную в ячейке С2 ?
Скажите пожалуйста, а возможно сделать так чтобы он не найдя соответствие, создавался столбец со сдвигом вправо к примеру и вносил дату проставленную в ячейке С2 ?Amon
Сообщение отредактировал Amon - Понедельник, 09.04.2018, 12:32
Amon, можно, для этого нужно определить куда вставлять этот столбец. Сделал 2 варианта, вставка в начало и в конец. Ненужное удалите или закомментируйте.
Amon, можно, для этого нужно определить куда вставлять этот столбец. Сделал 2 варианта, вставка в начало и в конец. Ненужное удалите или закомментируйте.Mikael
Amon, можно, для этого нужно определить куда вставлять этот столбец. Сделал 2 варианта, вставка в начало и в конец. Ненужное удалите или закомментируйте.
Спасибо большое, да. Только почему-то в моем варианте кода заливка с предыдущего столбца иногда перетекает в созданный столбец в других строках. [vba]
Код
Sub Макрос0() Dim rCell As Range With Worksheets("МП") If .Cells.Find(Worksheets("1").[c2]) Is Nothing Then d = CDate(Worksheets("1").[c2]) Do d = d - 1 If Not .Cells.Find(d) Is Nothing Then .Cells.Find(d).Offset(, 1).EntireColumn.Insert xlToRight .Cells.Find(d).Offset(, 1).Value = Worksheets("1").[c2] Exit Do End If If d = CDate(Worksheets("1").[c2]) - 1000 Then Exit Sub Loop '----------------------------------------------------------------- End If 'Пересечение строки 7 и столбца с датой. Для остальных макросов поменять номер строки здесь: .Rows(7) Set rCell = Intersect(.Rows(7), .Cells.Find(Worksheets("1").[c2]).EntireColumn) End With Dim a a = MsgBox("Программа установилась?", vbYesNoCancel, "Установка") With rCell If a = 6 Then .Value = "Ошибок нет" .Interior.Color = vbGreen ElseIf a = 7 Then .Value = "Введите описание ошибки" .Interior.Color = 65535 Worksheets("МП").Activate .Select Else End If End With End Sub
Amon, можно, для этого нужно определить куда вставлять этот столбец. Сделал 2 варианта, вставка в начало и в конец. Ненужное удалите или закомментируйте.
Спасибо большое, да. Только почему-то в моем варианте кода заливка с предыдущего столбца иногда перетекает в созданный столбец в других строках. [vba]
Код
Sub Макрос0() Dim rCell As Range With Worksheets("МП") If .Cells.Find(Worksheets("1").[c2]) Is Nothing Then d = CDate(Worksheets("1").[c2]) Do d = d - 1 If Not .Cells.Find(d) Is Nothing Then .Cells.Find(d).Offset(, 1).EntireColumn.Insert xlToRight .Cells.Find(d).Offset(, 1).Value = Worksheets("1").[c2] Exit Do End If If d = CDate(Worksheets("1").[c2]) - 1000 Then Exit Sub Loop '----------------------------------------------------------------- End If 'Пересечение строки 7 и столбца с датой. Для остальных макросов поменять номер строки здесь: .Rows(7) Set rCell = Intersect(.Rows(7), .Cells.Find(Worksheets("1").[c2]).EntireColumn) End With Dim a a = MsgBox("Программа установилась?", vbYesNoCancel, "Установка") With rCell If a = 6 Then .Value = "Ошибок нет" .Interior.Color = vbGreen ElseIf a = 7 Then .Value = "Введите описание ошибки" .Interior.Color = 65535 Worksheets("МП").Activate .Select Else End If End With End Sub
Скажите пожалуйста, возникла необходимость в подпунктах на втором листе, к примеру чтобы вносить в одну дату что-то вроде слов Тест 1 Тест 2 я пытался модифицировать ваш макрос но у меня даже на это ума не хватило. Просто на эту тему в интернете не могу найти информацию Или если можно сделать чтобы он искал не просто дату, а дату + время допустим
Скажите пожалуйста, возникла необходимость в подпунктах на втором листе, к примеру чтобы вносить в одну дату что-то вроде слов Тест 1 Тест 2 я пытался модифицировать ваш макрос но у меня даже на это ума не хватило. Просто на эту тему в интернете не могу найти информацию Или если можно сделать чтобы он искал не просто дату, а дату + время допустимAmon
Сообщение отредактировал Amon - Вторник, 10.04.2018, 14:42
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
