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

Регистрация

Напомнить пароль

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

Старая форма входа

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » объединить практически одинаковых два макроса (Макросы Sub)

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

Владимир

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

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

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

[vba]

Код

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

[/vba]

Ответить

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

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

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

Сообщений: 3209

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

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

2003

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

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

.Value = Now - Date

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

Код

.Value = Time

[/vba]
если дату и время, то [vba]

Код

.Value = Now

[/vba]
если только дату, то [vba]

Код

.Value = Date

[/vba]
а указанная у Вас разность [vba]

Код

.Value = Now - Date

[/vba] это какая-то бессмыслица

С уважением,
Алексей
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

Ответить

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

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

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

Сообщений: 1232

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

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

2003

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

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

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

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

Проверяйте
[vba]

Код

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

[/vba]

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

Ответить

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

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

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

Сообщений: 3209

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

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

2003

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

Код

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

[/vba]

С уважением,
Алексей
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

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

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

Сообщений: 3209

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

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

2003

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

hands

hands

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

Ответить

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

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

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

Сообщений: 3209

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

Замечаний: 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

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

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

Сообщений: 3209

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

Замечаний: 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

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

Замечаний: ±

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, Здравствуйте, подскажите пожайлуста по Вашему коду

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

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

Ответить

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

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

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

Сообщений: 1232

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

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

2003

Так наверное:
[vba]

Код

If Val(Target)>0 then

[/vba]
не проверял.

Ответить

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

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

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

Сообщений: 10

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

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

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

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

Ответить

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

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

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

Сообщений: 3209

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

Замечаний: 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 не исправил.
Конечно, так должно быть[vba]

Код

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

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

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

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

Ответить

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

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

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

Сообщений: 1613

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

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

Excel 2013, 2016

[offtop]

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

.Value = Now - пофигу

наверное, Type Mismatch

[/offtop]

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

Ответить

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

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

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

Сообщений: 3209

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

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

2003

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

наверное, Type Mismatch

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

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

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » объединить практически одинаковых два макроса (Макросы Sub)

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

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