Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/VBA-код выполняется заново,дойдя до определенной строки кода - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA-код выполняется заново,дойдя до определенной строки кода (Макросы/Sub)
VBA-код выполняется заново,дойдя до определенной строки кода
bygaga Дата: Вторник, 17.02.2015, 14:54 | Сообщение № 1
Группа: Пользователи
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003, 2007
Вот часть ВБА-кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
LRa = Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Cells.Find(what:="ВСЕГО", LookIn:=xlValues, LookAt:=xlPart).Row
LRd = Cells(Rows.Count, 4).End(xlUp).Row - 1
LRh = Cells(Rows.Count, 8).End(xlUp).Row
LRj = Cells(Rows.Count, 10).End(xlUp).Row

Set rZved = Range("A6:G" & LR2 - 1)

Set ZVED = ThisWorkbook.ActiveSheet

On Error Resume Next
If Target.Count > 1 Then Exit Sub

AEE = Application.EnableEvents
ASU = Application.ScreenUpdating
If Not Intersect(Target.Cells, rZved) Is Nothing Then

         AEE = False
         ASU = False
              
             If LRh > 6 Then
                 Range("A5:L" & LRh).Sort Key1:=[h6], Order1:=xlAscending, _
                 Header:=xlGuess, Orientation:=xlTopToBottom
             End If
             SumS = "=SUBTOTAL(9, R5C:R[-1]C)" 'And
             SumP = "=SUBTOTAL(9, R5C:R[-1]C)"
                  
                  
             If Cells(6, 11) > 0 Then
             Else
                 Cells(6, 11) = 1
             End If
                  
             If LRh > 6 Then
                 For x = 7 To LRh
                     If Cells(x, 8) > Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11) + 1
                     ElseIf Cells(x, 8) = Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11)
                     End If
                 Next x
             End If

             Cells(LR2, 4) = SumS
             Cells(LR2, 5) = SumP
              
         ASU = True
         AEE = True

End If
End Sub
[/vba]

Почему выполнив строчку Cells(LR2, 4) = SumS код начинается заново. Как это предотвратить?
П.С. Заголовки в строке 5
П.С.2: Cells(LR2, 4).formular1c1 = SumS не помогло


Сообщение отредактировал bygaga - Вторник, 17.02.2015, 14:58
 
Ответить
СообщениеВот часть ВБА-кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
LRa = Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Cells.Find(what:="ВСЕГО", LookIn:=xlValues, LookAt:=xlPart).Row
LRd = Cells(Rows.Count, 4).End(xlUp).Row - 1
LRh = Cells(Rows.Count, 8).End(xlUp).Row
LRj = Cells(Rows.Count, 10).End(xlUp).Row

Set rZved = Range("A6:G" & LR2 - 1)

Set ZVED = ThisWorkbook.ActiveSheet

On Error Resume Next
If Target.Count > 1 Then Exit Sub

AEE = Application.EnableEvents
ASU = Application.ScreenUpdating
If Not Intersect(Target.Cells, rZved) Is Nothing Then

         AEE = False
         ASU = False
              
             If LRh > 6 Then
                 Range("A5:L" & LRh).Sort Key1:=[h6], Order1:=xlAscending, _
                 Header:=xlGuess, Orientation:=xlTopToBottom
             End If
             SumS = "=SUBTOTAL(9, R5C:R[-1]C)" 'And
             SumP = "=SUBTOTAL(9, R5C:R[-1]C)"
                  
                  
             If Cells(6, 11) > 0 Then
             Else
                 Cells(6, 11) = 1
             End If
                  
             If LRh > 6 Then
                 For x = 7 To LRh
                     If Cells(x, 8) > Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11) + 1
                     ElseIf Cells(x, 8) = Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11)
                     End If
                 Next x
             End If

             Cells(LR2, 4) = SumS
             Cells(LR2, 5) = SumP
              
         ASU = True
         AEE = True

End If
End Sub
[/vba]

Почему выполнив строчку Cells(LR2, 4) = SumS код начинается заново. Как это предотвратить?
П.С. Заголовки в строке 5
П.С.2: Cells(LR2, 4).formular1c1 = SumS не помогло
Автор - bygaga
Дата добавления - 17.02.2015 в 14:54
DJ_Marker_MC Дата: Вторник, 17.02.2015, 15:09 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 991
Репутация: 213 ±
Замечаний: 0% ±

Excel 2019
в самое начало кода добавьте (сразу под Private Sub Worksheet_Change(ByVal Target As Range))
[vba]
Код
Application.EnableEvents = False
[/vba]
в самом конце перед End Sub
[vba]
Код
Application.EnableEvents = True
[/vba]
 
Ответить
Сообщениев самое начало кода добавьте (сразу под Private Sub Worksheet_Change(ByVal Target As Range))
[vba]
Код
Application.EnableEvents = False
[/vba]
в самом конце перед End Sub
[vba]
Код
Application.EnableEvents = True
[/vba]
Автор - DJ_Marker_MC
Дата добавления - 17.02.2015 в 15:09
Leanna Дата: Вторник, 17.02.2015, 15:18 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 78 ±
Замечаний: 0% ±

excel 2010
AEE = Application.EnableEvents у вас только присваивает значение True переменной AEE, можете по Locals глянуть.
А потом этой переменной вы присваиваете AEE = False, потом AEE = True. Отключение\включение событий здесь ни при чем.

Лучше день потерять, потом за пять минут долететь!
 
Ответить
СообщениеAEE = Application.EnableEvents у вас только присваивает значение True переменной AEE, можете по Locals глянуть.
А потом этой переменной вы присваиваете AEE = False, потом AEE = True. Отключение\включение событий здесь ни при чем.
Автор - Leanna
Дата добавления - 17.02.2015 в 15:18
DJ_Marker_MC Дата: Вторник, 17.02.2015, 15:24 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 991
Репутация: 213 ±
Замечаний: 0% ±

Excel 2019
Leanna, оу... я даже не увидел этого прикола с переменной)))

bygaga, удалите вот эти строки:
[vba]
Код
AEE = Application.EnableEvents
ASU = Application.ScreenUpdating
......
AEE = False
ASU = False
......
ASU = True
AEE = True
[/vba]

Короче вот так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
LRa = Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Cells.Find(what:="ВСЕГО", LookIn:=xlValues, LookAt:=xlPart).Row
LRd = Cells(Rows.Count, 4).End(xlUp).Row - 1
LRh = Cells(Rows.Count, 8).End(xlUp).Row
LRj = Cells(Rows.Count, 10).End(xlUp).Row

Set rZved = Range("A6:G" & LR2 - 1)

Set ZVED = ThisWorkbook.ActiveSheet

On Error Resume Next
If Target.Count > 1 Then Exit Sub

If Not Intersect(Target.Cells, rZved) Is Nothing Then
             
             If LRh > 6 Then
                 Range("A5:L" & LRh).Sort Key1:=[h6], Order1:=xlAscending, _
                 Header:=xlGuess, Orientation:=xlTopToBottom
             End If
             SumS = "=SUBTOTAL(9, R5C:R[-1]C)" 'And
             SumP = "=SUBTOTAL(9, R5C:R[-1]C)"
                  
                  
             If Cells(6, 11) > 0 Then
             Else
                 Cells(6, 11) = 1
             End If
                  
             If LRh > 6 Then
                 For x = 7 To LRh
                     If Cells(x, 8) > Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11) + 1
                     ElseIf Cells(x, 8) = Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11)
                     End If
                 Next x
             End If

             Cells(LR2, 4) = SumS
             Cells(LR2, 5) = SumP
              
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
[/vba]
 
Ответить
СообщениеLeanna, оу... я даже не увидел этого прикола с переменной)))

bygaga, удалите вот эти строки:
[vba]
Код
AEE = Application.EnableEvents
ASU = Application.ScreenUpdating
......
AEE = False
ASU = False
......
ASU = True
AEE = True
[/vba]

Короче вот так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
LRa = Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Cells.Find(what:="ВСЕГО", LookIn:=xlValues, LookAt:=xlPart).Row
LRd = Cells(Rows.Count, 4).End(xlUp).Row - 1
LRh = Cells(Rows.Count, 8).End(xlUp).Row
LRj = Cells(Rows.Count, 10).End(xlUp).Row

Set rZved = Range("A6:G" & LR2 - 1)

Set ZVED = ThisWorkbook.ActiveSheet

On Error Resume Next
If Target.Count > 1 Then Exit Sub

If Not Intersect(Target.Cells, rZved) Is Nothing Then
             
             If LRh > 6 Then
                 Range("A5:L" & LRh).Sort Key1:=[h6], Order1:=xlAscending, _
                 Header:=xlGuess, Orientation:=xlTopToBottom
             End If
             SumS = "=SUBTOTAL(9, R5C:R[-1]C)" 'And
             SumP = "=SUBTOTAL(9, R5C:R[-1]C)"
                  
                  
             If Cells(6, 11) > 0 Then
             Else
                 Cells(6, 11) = 1
             End If
                  
             If LRh > 6 Then
                 For x = 7 To LRh
                     If Cells(x, 8) > Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11) + 1
                     ElseIf Cells(x, 8) = Cells(x - 1, 8) And Cells(x, 8) > 0 Then
                         Cells(x, 11) = Cells(x - 1, 11)
                     End If
                 Next x
             End If

             Cells(LR2, 4) = SumS
             Cells(LR2, 5) = SumP
              
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - DJ_Marker_MC
Дата добавления - 17.02.2015 в 15:24
Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA-код выполняется заново,дойдя до определенной строки кода (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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