объединить практически одинаковых два макроса - Мир MS Excel

Версия для слабовидящих

= Мир MS Excel/объединить практически одинаковых два макроса - Мир MS Excel

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_, DrMini

объединить практически одинаковых два макроса (Макросы Sub)

объединить практически одинаковых два макроса

Владимир Дата: Воскресенье, 02.03.2014, 19:08 | Сообщение № 1

Группа: Гости

Здравствуйте, помогите пожайлуста объединить практически одинаковых два макроса
работающий в разных диапазонах
Первый вставляет дату , второй - время

Private Sub Worksheet_Change(ByVal Target As Range) ' Òîëüêî îäíà ÿ÷åéêà If Target.Cells.Count > 1 Then Exit Sub End If For Each cell In Target If Not Intersect(cell, Range("D2:D1100")) Is Nothing And _ Target.Offset(0, -1) = "" Then With Target.Offset(0, -1) ActiveSheet.Unprotect Password:="1" .Value = Now ActiveSheet.Protect Password:="1" End With End If Next cell End Sub и второй Private Sub Worksheet_Change(ByVal Target As Range) ' Òîëüêî îäíà ÿ÷åéêà If Target.Cells.Count > 1 Then Exit Sub End If For Each cell In Target If Not Intersect(cell, Range("F2:F1000")) Is Nothing And _ Target.Offset(0, 4) = "" Then With Target.Offset(0, 4) ActiveSheet.Unprotect Password:="1" .Value = Now - Date ' ActiveSheet.Protect Password:="1" End With End If Next cell End Sub

Ответить

Alex_ST Дата: Воскресенье, 02.03.2014, 20:31 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Я что-то не пойму, что Вы ожидали получить во втором макросе, написав

Цитата Владимир, 02.03.2014 в 19:08, в сообщении № 1

.Value = Now - Date

Если Вам нужно было просто текущее время, то надо писать

.Value = Time

если дату и время, то

.Value = Now

если только дату, то

.Value = Date

а указанная у Вас разность

.Value = Now - Date

это какая-то бессмыслица

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Воскресенье, 02.03.2014, 20:32

Ответить

Владимир

Дата: Воскресенье, 02.03.2014, 21:12 | Сообщение № 3

Группа: Гости

Alex_ST, Вы правы, но в принципе

.Value = Now - Date выполняет то-же, что и
.Value = Time - вставляет время,

вопрос по объединению макросов открыт,
хотя решен с помощью GoTo

Ответить

Wasilich Дата: Воскресенье, 02.03.2014, 21:19 | Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Цитата Alex_ST, 02.03.2014 в 20:31, в сообщении № 2

объединить практически одинаковых два макроса

А по отдельности они работают?

PS, точно работают. Тогда внесите оба действия в одну процедуру Sub но разделите диапазонами обработки.
Типа
если D1:D1000
Процедура
ендиф
если F1:F1000
Процедура
ендиф.

Проверяйте

Private Sub Worksheet_Change(ByVal Target As Range) ' ActiveSheet.Unprotect Password:="1" If Target.Cells.Count > 1 Then Exit Sub If Not Application.Intersect(Range("D2:D1100"), Target) Is Nothing Then If Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Date End If If Not Application.Intersect(Range("F2:F1100"), Target) Is Nothing Then If Target.Offset(0, 4) = "" Then Target.Offset(0, 4).Value = Time End If ' ActiveSheet.Protect Password:="1" End Sub

Сообщение отредактировал Wasilic - Воскресенье, 02.03.2014, 21:50

Ответить

Alex_ST Дата: Воскресенье, 02.03.2014, 21:49 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Ну да, тогда после причёсывания кода получится что-то типа

Private Sub Worksheet_Change(ByVal Target As Range) 'Dim rCell As Range If Target.Cells.Count > 1 Then Exit Sub 'Только одна ячейка ActiveSheet.Unprotect Password:="1" 'For Each rCell In Target ' цикл не нужен, т.к. ячейка в Target всего одна If Not Intersect(rCell, Range("D2:D1100")) Is Nothing And Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Now If Not Intersect(rCell, Range("F2:F1000")) Is Nothing And Target.Offset(0, 4) = "" Then Target.Offset(0, 4).Value = Time 'Next rCell ActiveSheet.Protect Password:="1" End Sub

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Воскресенье, 02.03.2014, 22:00

Ответить

Дата: Воскресенье, 02.03.2014, 21:51 | Сообщение № 6

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Только не понимаю, зачем цикл?

Сообщение отредактировал Wasilic - Воскресенье, 02.03.2014, 21:56

Ответить

Дата: Воскресенье, 02.03.2014, 21:53 | Сообщение № 7

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Василич, дуплет!

hands

hands

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Воскресенье, 02.03.2014, 21:57 | Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Да, блин... А тупого цикла по единственной ячейке я там не заметил...
Стыжусть. Конечно, он нафиг не нужен. Заремарил свой срам в предыдущем посте.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Воскресенье, 02.03.2014, 22:02 | Сообщение № 9

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Цитата Alex_ST, 02.03.2014 в 21:57, в сообщении № 8

Конечно, он нафиг не нужен.

Ну, это ТС надо спросить. Мож мы чего не учли.

Ответить

Дата: Воскресенье, 02.03.2014, 22:05 | Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Ну, вообще-то там даже в комментариях кракозябрами написано, что ячейка в Target одна. Поэтому цикл по-любому не нужен (хотя никому и не мешает, конечно

)
Так что это я просто по невнимательности цикл оставил. Недоупростил...

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Владимир

Дата: Воскресенье, 02.03.2014, 22:22 | Сообщение № 11

Группа: Гости

Alex_ST, спасибо за помощь, получилось аккуратно, но почему-то выдает ошибку на строке

If Not Intersect(rCell, Range("D2:D1100")) Is Nothing And Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Now

циклы не нужны

P.S. Код подтверждения не могу различить, гадаю

Ответить

Дата: Воскресенье, 02.03.2014, 22:31 | Сообщение № 12

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2750 ±

Замечаний: ±

Excel 2016

Цитата Владимир, 02.03.2014 в 22:22, в сообщении № 11

Код подтверждения не могу различить, гадаю

Для зарегистрированных пользователей код подтверждения отключен, так что если жаль одной-двух минут на регистрацию - гадайте дальше

ЮMoney:41001419691823 | WMR:126292472390

Ответить

Дата: Воскресенье, 02.03.2014, 22:34 | Сообщение № 13

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

А мой код? Тоже не работает?

Ответить

Владимир

Дата: Воскресенье, 02.03.2014, 23:01 | Сообщение № 14

Группа: Гости

Wasilic, Ваш код работает.

Всем огромное спасибо

Ответить

Дата: Воскресенье, 02.03.2014, 23:17 | Сообщение № 15

Группа: Пользователи

Ранг: Новичок

Сообщений: 10

Репутация: 0 ±

Замечаний: 0% ±

Wasilic, Здравствуйте, подскажите пожайлуста по Вашему коду

как проверить в рабочем диапазоне, что введено число, а не просто дважды топнули мышкой

Учился. Учусь. Буду учиться !!!

Ответить

Wasilich Дата: Воскресенье, 02.03.2014, 23:29 | Сообщение № 16

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Так наверное:

If Val(Target)>0 then

не проверял.

Ответить

Дата: Воскресенье, 02.03.2014, 23:54 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 10

Репутация: 0 ±

Замечаний: 0% ±

Wasilic,
Получилось, спасибо

Учился. Учусь. Буду учиться !!!

Ответить

Alex_ST Дата: Понедельник, 03.03.2014, 09:29 | Сообщение № 18

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Цитата Владимир, 02.03.2014 в 23:01, в сообщении № 14

Wasilic, Ваш код работает

Что-то я не въеду, почему у ТС работает это

Цитата Wasilic, 02.03.2014 в 21:19, в сообщении № 4

If Not Application.Intersect(Range("D2:D1100"), Target) Is Nothing Then
If Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Date
End If

и не работает это

Цитата Alex_ST, 02.03.2014 в 21:49, в сообщении № 5

If Not Intersect(rCell, Range("D2:D1100")) Is Nothing And Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Now

Не вижу принципиальной разницы...
Intersect всегда и у всех нормально работает без предваряющего Application. Что .Value = Date, что .Value = Now - пофигу, только данные разные будут выводиться.
Да и остальное - те же … , но в профиль

---------------------------------
Блин! Понял! Остатки тупого цикла по единственной rCell на Target не исправил.
Конечно, так должно быть

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub 'Только одна ячейка ActiveSheet.Unprotect Password:="1" If Not Intersect(Target, ["D2:D1100"]) Is Nothing And Target.Offset(0, -1) = "" Then Target.Offset(0, -1).Value = Now If Not Intersect(Target, ["F2:F1000"]) Is Nothing And Target.Offset(0, 4) = "" Then Target.Offset(0, 4).Value = Time ActiveSheet.Protect Password:="1" End Sub

Всё. Больше дома в воскресенье вечером не программирую.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Понедельник, 03.03.2014, 09:35

Ответить

Дата: Понедельник, 03.03.2014, 11:01 | Сообщение № 19

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

Оффтоп:

Цитата Alex_ST, 03.03.2014 в 09:29, в сообщении № 18

.Value = Now - пофигу

наверное, Type Mismatch

Яндекс.Деньги 4100159601573

Ответить

Дата: Понедельник, 03.03.2014, 11:04 | Сообщение № 20

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3219

Репутация: 622 ±

Замечаний: 0% ±

2003

Цитата nilem, 03.03.2014 в 11:01, в сообщении № 19

наверное, Type Mismatch

Нет. Просто не rCell, а Target нужно было писать после ремарок на цикле.
Уже исправил. Должно работать. Но без файла-примера проверить, естественно, никак.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

объединить практически одинаковых два макроса (Макросы Sub)

Страница 1 из 2
1
2
»

© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!