powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Почему долго чехлиться?
8 сообщений из 8, страница 1 из 1
Почему долго чехлиться?
    #35663937
Shaher-Maher
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Всем доброе время суток.
Вот скрипт. Вопрос почему файл екселя при обработке строки Range("E6:F23").ClearContents очень долго чехлиться или тупо подвисает?

Код: plaintext
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.
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("E5:E6")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    
    If Not Intersect(Target, Range("E5, E6")) Is Nothing Then
        If Range("E5") = "" Then
            Rows("6:23").Hidden = True
            Range("E6:F23").ClearContents
        Else
            Rows("6").Hidden = False
        End If
        
        If Range("E6") = "" Then
            Rows("7:23").Hidden = True
        Else
            Rows("7").Hidden = False
        End If
        
    End If
            

End Sub
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35663985
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shaher-Maher, а ты знаешь, что есть такая штука, как пошаговая отладка программы ? Пройдись по шагам и глянь что происходит ;-) У тебя после строки Range("E6:F23").ClearContents опять запускается событие Worksheet_Change(). И так до бесконечности ;-)
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35664135
Shaher-Maher
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Проблема таже - висит при полнйо обработке скрипта. Вот весь скрипт. Я конечно понимаю, что он каждый раз обращается, но как мне избегнуть этого при моей задачи пока ума не приложу :)

Код: plaintext
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.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("E5:E23")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    
    If Not Intersect(Target, Range("E5")) Is Nothing Then
        If Range("E5") = "" Then
            Rows("6:23").Hidden = True
            Range("E6:F23").ClearContents
        Else
            Rows("6").Hidden = False
        End If
    End If
    
    If Not Intersect(Target, Range("E6")) Is Nothing Then
     
        If Range("E6") = "" Then
           Rows("7:23").Hidden = True
           Range("E7:F23").ClearContents
        Else
            Rows("7").Hidden = False
        End If
    End If
    
    If Not Intersect(Target, Range("E7")) Is Nothing Then
       If Range("E7") = "" Then
            Rows("8:23").Hidden = True
            Range("E8:F23").ClearContents
        Else
            Rows("8").Hidden = False
        End If
    End If
        
    If Not Intersect(Target, Range("E8")) Is Nothing Then
        If Range("E8") = "" Then
            Rows("9:23").Hidden = True
            Range("E9:F23").ClearContents
        Else
            Rows("9").Hidden = False
        End If
    End If
        
    If Not Intersect(Target, Range("E9")) Is Nothing Then
            If Range("E9") = "" Then
            Rows("10:23").Hidden = True
            Range("E10:F23").ClearContents
        Else
            Rows("10").Hidden = False
        End If
    End If
            
    If Not Intersect(Target, Range("E10")) Is Nothing Then
         If Range("E10") = "" Then
            Rows("11:23").Hidden = True
            Range("E11:F23").ClearContents
         Else
            Rows("11").Hidden = False
         End If
     End If
                                   
    If Not Intersect(Target, Range("E11")) Is Nothing Then
        If Range("E11") = "" Then
            Rows("12:23").Hidden = True
            Range("E12:F23").ClearContents
        Else
            Rows("12").Hidden = False
        End If
    End If

    If Not Intersect(Target, Range("E12")) Is Nothing Then
        If Range("E12") = "" Then
            Rows("13:23").Hidden = True
            Range("E13:F23").ClearContents
        Else
            Rows("13").Hidden = False
        End If
    End If
    
    If Not Intersect(Target, Range("E13")) Is Nothing Then
        If Range("E13") = "" Then
            Rows("14:23").Hidden = True
            Range("E14:F23").ClearContents
        Else
            Rows("14").Hidden = False
        End If
    End If
    
    If Not Intersect(Target, Range("E14")) Is Nothing Then
        If Range("E14") = "" Then
            Rows("15:23").Hidden = True
            Range("E14:F23").ClearContents
        Else
            Rows("15").Hidden = False
        End If
    End If
 
    If Not Intersect(Target, Range("E15")) Is Nothing Then
        If Range("E15") = "" Then
            Rows("16:23").Hidden = True
            Range("E16:F23").ClearContents
        Else
            Rows("16").Hidden = False
        End If
    End If
    
    If Not Intersect(Target, Range("E16")) Is Nothing Then
        If Range("E16") = "" Then
            Rows("17:23").Hidden = True
            Range("E17:F23").ClearContents
        Else
            Rows("17").Hidden = False
        End If
    End If
 
    If Not Intersect(Target, Range("E17")) Is Nothing Then
        If Range("E17") = "" Then
            Rows("18:23").Hidden = True
            Range("E18:F23").ClearContents
        Else
            Rows("18").Hidden = False
        End If
    End If
   
    If Not Intersect(Target, Range("E18")) Is Nothing Then
        If Range("E18") = "" Then
            Rows("19:23").Hidden = True
            Range("E19:F23").ClearContents
        Else
            Rows("19").Hidden = False
        End If
    End If

    If Not Intersect(Target, Range("E19")) Is Nothing Then
        If Range("E19") = "" Then
            Rows("20:23").Hidden = True
            Range("E20:F23").ClearContents
        Else
            Rows("20").Hidden = False
        End If
    End If

    If Not Intersect(Target, Range("E20")) Is Nothing Then
        If Range("E20") = "" Then
            Rows("21:23").Hidden = True
            Range("E21:F23").ClearContents
        Else
            Rows("21").Hidden = False
        End If
    End If
 
    If Not Intersect(Target, Range("E21")) Is Nothing Then
        If Range("E21") = "" Then
            Rows("22:23").Hidden = True
            Range("E22:F23").ClearContents
        Else
            Rows("22").Hidden = False
        End If
    End If
   
    If Not Intersect(Target, Range("E22")) Is Nothing Then
           If Range("E22") = "" Then
            Rows("23:23").Hidden = True
            Range("E23:F23").ClearContents
        Else
            Rows("23").Hidden = False
        End If
    End If
    

End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("E4:F23").ClearContents
End Sub

...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35664276
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробуй так:

Option Explicit

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, rng As Range
    Set rng = Intersect(Target, Range("E5:E22"))
    If rng Is Nothing Then Exit Sub
    With Application: .ScreenUpdating = False: .EnableEvents = False: End With
    For i =  1  To rng.Cells.Count
        If rng(i) = "" Then
            With Range(rng(i +  1 ), Cells( 23 , "F"))
                .ClearContents
                .EntireRow.Hidden = True
            End With
            Exit For
        Else
           rng(i +  1 ).EntireRow.Hidden = False
        End If
    Next i
    With Application: .ScreenUpdating = True: .EnableEvents = True: End With
End Sub
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35664316
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Или же использовать Application.EnableEvents=False .
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35664416
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
big-dukeИли же использовать Application.EnableEvents=False .
:)

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, rng As Range
    Set rng = Intersect(Target, Range("E5:E22"))
    If rng Is Nothing Then Exit Sub
    With Application: .ScreenUpdating = False: .EnableEvents = False: End With
    For i =  1  To rng.Cells.Count
        If rng(i) = "" Then
            With Range(rng(i +  1 ), Cells( 23 , "F"))
                .ClearContents
                .EntireRow.Hidden = True
            End With
            Exit For
        Else
           rng(i +  1 ).EntireRow.Hidden = False
        End If
    Next i
    With Application: .ScreenUpdating = True: .EnableEvents = True: End With
End Sub
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35664963
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Аааа... я забыл, что можно записывать операторы через :
:)
...
Рейтинг: 0 / 0
Почему долго чехлиться?
    #35665549
Shaher-Maher
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ОО цикл. точно ..спс..я вчера чего забыл про него
...
Рейтинг: 0 / 0
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Почему долго чехлиться?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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