ReSQL.ru
     
powered by simpleCommunicator - 2.0.57     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Два макроса Worksheet_Change на одном листе
8 сообщений из 8, страница 1 из 1
Два макроса Worksheet_Change на одном листе
    #37582214
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
Всем здравствуйте и с наступающим! Помогите пжл решить проблемку.
Есть у меня в одной книге два макроса
один на одном листе другой на другом...по одиночку они работают нормально..., но мне нужно чтобы они работали на ОДНОМ листе, и если я их в исходный текст листа запихиваю, то эксель ругается на само имя макроса (типо нельзя повторяющееся имя использовать), если я его меняю например на Worksheet_Change2, то этот макрос который переименовал не работает, если оба макроса запихиваю под одно название, эксель тупит и виснит..
вот эти макросы...помогите их совместить на одном листе..
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A1")) Is Nothing Then
With Target
If Range("A1").Text = "легковые" Then
 Range("A2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Марки"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
Else
If Range("A1").Text = "грузовые" Then
 Range("A3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Марки"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
    Else
If Range("A1").Text = "легковые отечественные" Then
 Range("A4").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=бабло"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
End If
End If
End If
End With
End If
Application.EnableEvents = True

End Sub



и второй
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
Dim dDate As Date

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("N7:N8")) Is Nothing Then
With Target
StrVal = Format(.Text, "000000")
If IsNumeric(StrVal) And Len(StrVal) = 6 Then
Application.EnableEvents = False
dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
.NumberFormat = "dd/mm/yyyy"
.Value = dDate
End If
End With
End If
    
Application.EnableEvents = True

End Sub
...
Рейтинг: 0 / 0
18.12.2011, 23:57
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582218
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
запихните все в одну процедуру
то есть вместо:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 1

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 2

End Sub


сделать
Код: vbnet
1.
2.
3.
4.
5.
6.
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 1
Действия 2

End Sub


ну подковырять там немножко, лишнее убрать, если есть
...
Рейтинг: 0 / 0
19.12.2011, 00:03
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582227
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
да делал так уже, эксел зависал...ща еще раз попробую и здесь выложу, может подкорректировать что надо будет..
...
Рейтинг: 0 / 0
19.12.2011, 00:14
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582228
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Geo28да делал так уже, эксел зависалзначит зациклили - макрос рекурсивно вызывает сам себя, изменяя сам ячейки. Поставьте Application.EnableEvents = False в самом начале процедуры
...
Рейтинг: 0 / 0
19.12.2011, 00:15
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582230
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
вот так вроде работает:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
Dim dDate As Date

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("N7:N8")) Is Nothing Then
With Target
StrVal = Format(.Text, "000000")
If IsNumeric(StrVal) And Len(StrVal) = 6 Then
Application.EnableEvents = False
dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
.NumberFormat = "dd/mm/yyyy"
.Value = dDate
End If
End With
End If
    
If Not Intersect(Target, Range("A1:A1")) Is Nothing Then
With Target
If Range("A1").Text = "легковые" Then
 Range("A2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Марки"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
Else
If Range("A1").Text = "грузовые" Then
 Range("A3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Марки"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
    Else
If Range("A1").Text = "легковые отечественные" Then
 Range("A4").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=бабло"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
End If
End If
End If
End With
End If
Application.EnableEvents = True

End Sub
...
Рейтинг: 0 / 0
19.12.2011, 00:17
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582235
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
вот так ругается на строчку во второй части макроса
If Range("AÀ12").Text = "легковые" Then
ошибка 1004 Method Range of object_Worksheet failed

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
Dim dDate As Date

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("N7:N8")) Is Nothing Then
With Target
StrVal = Format(.Text, "000000")
If IsNumeric(StrVal) And Len(StrVal) = 6 Then
Application.EnableEvents = False
dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
.NumberFormat = "dd/mm/yyyy"
.Value = dDate
End If
End With
End If
    
If Not Intersect(Target, Range("AA12:AA12")) Is Nothing Then
With Target
If Range("AÀ12").Text = "ëåãêîâûå" Then
 Range("AA15").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=ìîäåëè"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
Else
If Range("AA12").Text = "ãðóçîâûå" Then
 Range("AA15").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Ìàðêè"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
    Else
If Range("AA12").Text = "ëåãêîâûå îòå÷åñòâåííûå" Then
 Range("AA15").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=áàáëî"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
End If
End If
End If
End With
End If
Application.EnableEvents = True

End Sub
...
Рейтинг: 0 / 0
19.12.2011, 00:25
| Ответить | Цитировать | Написать  
Два макроса Worksheet_Change на одном листе
    #37582242
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
нашел косяк диапазон Range вторая буква на русском языке была))
...
Рейтинг: 0 / 0
19.12.2011, 00:30
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Два макроса Worksheet_Change на одном листе
    #38560309
Валодья
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Валодья
Гость
Shocker.Proзапихните все в одну процедуру
то есть вместо:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 1

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 2

End Sub


сделать
Код: vbnet
1.
2.
3.
4.
5.
6.
Private Sub Worksheet_Change(ByVal Target As Range)

Действия 1
Действия 2

End Sub


ну подковырять там немножко, лишнее убрать, если есть
Мне помогло спасибо!
...
Рейтинг: 0 / 0
13.02.2014, 19:03
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Два макроса Worksheet_Change на одном листе
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=64&tid=2174239]:
 0ms
get settings:
 10ms
get forum list:
 13ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 39ms
get topic data:
 13ms
get forum data:
 3ms
get page messages:
 95ms
get tp. blocked users:
 2ms
others: 15ms
total:  198ms
созд. / загр.: 198ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]