Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Два макроса Worksheet_Change на одном листе / 8 сообщений из 8, страница 1 из 1
18.12.2011, 23:57
    #37582214
Geo28
Geo28
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
Всем здравствуйте и с наступающим! Помогите пжл решить проблемку.
Есть у меня в одной книге два макроса
один на одном листе другой на другом...по одиночку они работают нормально..., но мне нужно чтобы они работали на ОДНОМ листе, и если я их в исходный текст листа запихиваю, то эксель ругается на само имя макроса (типо нельзя повторяющееся имя использовать), если я его меняю например на 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
| Ответить | Цитировать | Написать  
19.12.2011, 00:03
    #37582218
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
запихните все в одну процедуру
то есть вместо:
Код: 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:14
    #37582227
Geo28
Geo28
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
да делал так уже, эксел зависал...ща еще раз попробую и здесь выложу, может подкорректировать что надо будет..
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.12.2011, 00:15
    #37582228
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
Geo28да делал так уже, эксел зависалзначит зациклили - макрос рекурсивно вызывает сам себя, изменяя сам ячейки. Поставьте Application.EnableEvents = False в самом начале процедуры
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.12.2011, 00:17
    #37582230
Geo28
Geo28
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
вот так вроде работает:

Код: 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:25
    #37582235
Geo28
Geo28
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
вот так ругается на строчку во второй части макроса
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:30
    #37582242
Geo28
Geo28
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
нашел косяк диапазон Range вторая буква на русском языке была))
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
13.02.2014, 19:03
    #38560309
Валодья
Валодья
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Два макроса Worksheet_Change на одном листе
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
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Два макроса Worksheet_Change на одном листе / 8 сообщений из 8, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 470ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2174239]:
 0ms
get settings:
 9ms
get forum list:
 16ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 60ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 49ms
get tp. blocked users:
 1ms
others: 314ms
total:  470ms
x
x
Закрыть


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