Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
ПОДСКАЖИТЕ : как сделать изменение изображение во время выполнения процесса скрытия строк !!!
 
#1
18.01.2011 10:58:21
У меня в книге excel 2007 есть уже рабочий макрос, который скрывает все пустые строки, (т.е. те строки, значение в первой ячейке в первом столбце у которых равно 0):  
 
   Application.ScreenUpdating = False  
   For x = 1 To Columns("A:A").SpecialCells(xlLastCell).Row  
   If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
   Next x  
   Application.ScreenUpdating = True  
 
Так вот это процесс занимает определенное время для выполенния и я сделал макрос, который в начале переходит на ячейку, где я написал просто примерное время выполения процесса и сделал пояснения , что нужно подождать (так сказать экран ожидания выполнения процесса).  
 
макрос такой:  
       
Application.Goto Reference:="R158C1"  
 
И мне захотелось сделать чтобы во время выполнения этого процесса показывался индикатор выполнения процесса (т.е. нарисованная линия с постепенным появлением 10 квадратиков - от 10% до 100%) и я сделал несколько таких экранов ожидания с этим индикатором, и в нужных ячейках ввел значения 10, 20, 30 ... 100 (т.е. проценты как-бы выполнения). и когда процесс скрытия строк определяет, что значение допутим равно 10, то переходит на ячейку где у меня экран ожидания с индикатором выполенния на 10% и так далее, вот что у меня получилось, но это не работает правильно :  
 
   Application.ScreenUpdating = False  
   For x = 1 To Columns("A:A").SpecialCells(xlLastCell).Row  
   If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
    If Cells(x, 1) = 10 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R160C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 20 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R162C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 30 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R164C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 40 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R166C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 50 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R168C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 60 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R170C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 70 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R172C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 80 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R174C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 90 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R176C1"  
   Application.ScreenUpdating = False  
    If Cells(x, 1) = 100 Then Rows(x).Hidden = True  
   Application.ScreenUpdating = True  
   Application.Goto Reference:="R178C1"  
   Application.ScreenUpdating = False  
   Next x  
   Application.ScreenUpdating = True  
 
Подскажите что я ввел не так ??? Или может быть есть другой вариант чтобы показывался индикатор выполнения процесса ???  
помогите кто знает, спасибо !!!
 
 
 
#2
18.01.2011 11:40:24
У вас скрываються строки где не только = 0 в первом столбце  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
If Cells(x, 1) = 10 Then Rows(x).Hidden = True    
.......  
If Cells(x, 1) = 100 Then Rows(x).Hidden = True  
 
а для отображения попробуйте разбить максимальное значение -  
Columns("A:A").SpecialCells(xlLastCell).Row на 10 сектаров :  
cektor = Cdbl((Columns("A:A").SpecialCells(xlLastCell).Row /x)*100)  
 
и через например case сделать выбор:  
 
select case cektor  
  case if > 10:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R160C1"  
        Application.ScreenUpdating = False    
  case if > 20:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R162C1"  
        Application.ScreenUpdating = False    
  .....  
  case if > 90:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R176C1"  
        Application.ScreenUpdating = False    
  case 100: :    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R178C1"  
        Application.ScreenUpdating = False    
end select
 
 
 
#3
18.01.2011 11:58:09
{quote}{login=MrViper}{date=18.01.2011 11:40}{thema=}{post}У вас скрываються строки где не только = 0 в первом столбце  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
If Cells(x, 1) = 10 Then Rows(x).Hidden = True    
.......  
If Cells(x, 1) = 100 Then Rows(x).Hidden = True  
 
а для отображения попробуйте разбить максимальное значение -  
Columns("A:A").SpecialCells(xlLastCell).Row на 10 сектаров :  
cektor = Cdbl((Columns("A:A").SpecialCells(xlLastCell).Row /x)*100)  
 
и через например case сделать выбор:  
 
select case cektor  
  case if > 10:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R160C1"  
        Application.ScreenUpdating = False    
  case if > 20:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R162C1"  
        Application.ScreenUpdating = False    
  .....  
  case if > 90:    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R176C1"  
        Application.ScreenUpdating = False    
  case 100: :    
        Application.ScreenUpdating = True  
        Application.Goto Reference:="R178C1"  
        Application.ScreenUpdating = False    
end select{/post}{/quote}  
 
ПОЖАЛУЙСТА! Я не совсем близко знаком с правильным составлением макросов и языка не знаю. Вы можете весь мой скрипт выполнения процесса исправить и показать как нужно писать, от начала до конца. А то я вставляю но excel ругается ошибки выдает........
 
 
 
#4
18.01.2011 11:58:11
Может лучше вроде этого сделать?  
 
'очень круто)  
Sub test4()  
For i = 1 To 10000  
p = i \ 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
DoEvents  
Next  
Application.StatusBar = False  
End Sub
 
 
 
#5
18.01.2011 12:01:42
{quote}{login=Hugo}{date=18.01.2011 11:58}{thema=}{post}Может лучше вроде этого сделать?  
 
'очень круто)  
Sub test4()  
For i = 1 To 10000  
p = i \ 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
DoEvents  
Next  
Application.StatusBar = False  
End Sub{/post}{/quote}  
 
Я сам правильно не смог вставить ваш скрипт, куда мне что нужно вставить, пожалуйста все напишите как должно быть у меня от начала до конца....  
спасибо!
 
 
 
#6
18.01.2011 12:08:13
Где выводится статусбар знаете?  
Тогда так:  
 
'очень круто)  
Sub test4()  
Dim x As Long, iLastrow As Long, p As Long, s As String  
Application.ScreenUpdating = False  
 
iLastrow = Columns("A:A").SpecialCells(xlLastCell).Row  
For x = 1 To iLastrow  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
DoEvents  
Next  
 
Application.ScreenUpdating = True  
Application.StatusBar = False  
End Sub
 
 
 
#7
18.01.2011 12:28:34
{quote}{login=Hugo}{date=18.01.2011 12:08}{thema=}{post}Где выводится статусбар знаете?  
Тогда так:  
 
'очень круто)  
Sub test4()  
Dim x As Long, iLastrow As Long, p As Long, s As String  
Application.ScreenUpdating = False  
 
iLastrow = Columns("A:A").SpecialCells(xlLastCell).Row  
For x = 1 To iLastrow  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
DoEvents  
Next  
 
Application.ScreenUpdating = True  
Application.StatusBar = False  
End Sub{/post}{/quote}  
============================================  
ну вроде работает, только вот медленнее стало выполняться, чем раньше и еще на 89% конкретно у меня сразу заканчивается, т.е. полностью выполняется т.е. промежуток процентов от 90% до 100% почему то выполняется намного быстрее чем весь процесс мнгновенно. почеум так ???
 
 
 
#8
18.01.2011 12:37:32
Ну да, статусбар притормаживает код.  
Можно чуть облегчить, ограничив например вывод каждым сотым значением:  
 
If x Mod 100 = 0 Then  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
End If  
 
А почему в конце косячит - не знаю, может там ничего скрывать не нужно, поэтому быстро проскакивает?
 
 
 
#9
18.01.2011 12:45:45
{quote}{login=Hugo}{date=18.01.2011 12:37}{thema=}{post}Ну да, статусбар притормаживает код.  
Можно чуть облегчить, ограничив например вывод каждым сотым значением:  
 
If x Mod 100 = 0 Then  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
End If  
 
А почему в конце косячит - не знаю, может там ничего скрывать не нужно, поэтому быстро проскакивает?{/post}{/quote}  
 
я не совсем понял куда это нужно вставлять, я же не знаю язык, напишите пожалуйста весь скрипт полностью с этим скриптом, чтобы было все понятно  
спасибо......
 
 
 
#10
18.01.2011 12:52:04
Тут всего лишь добавлено одно условие, которым ограничивается собственно сам процесс подсчёта и вывода данных в статусбар:  
 
 
Sub test4()  
Dim x As Long, iLastrow As Long, p As Long, s As String  
Application.ScreenUpdating = False  
 
iLastrow = Columns("A:A").SpecialCells(xlLastCell).Row  
For x = 1 To iLastrow  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
If x Mod 100 = 0 Then  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
End If  
DoEvents  
Next  
 
Application.ScreenUpdating = True  
Application.StatusBar = False  
End Sub
 
 
 
#11
18.01.2011 13:00:56
{quote}{login=Hugo}{date=18.01.2011 12:52}{thema=}{post}Тут всего лишь добавлено одно условие, которым ограничивается собственно сам процесс подсчёта и вывода данных в статусбар:  
 
 
Sub test4()  
Dim x As Long, iLastrow As Long, p As Long, s As String  
Application.ScreenUpdating = False  
 
iLastrow = Columns("A:A").SpecialCells(xlLastCell).Row  
For x = 1 To iLastrow  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
If x Mod 100 = 0 Then  
p = x \ iLastrow / 100  
s = String(p \ 10, ChrW(9632)) & String(10 - p \ 10, ChrW(9633))  
Application.StatusBar = "Выполнено: " & p & "% " & s  
End If  
DoEvents  
Next  
 
Application.ScreenUpdating = True  
Application.StatusBar = False  
End Sub{/post}{/quote}  
 
неее так не катит, получается процесс выполняется, а статус бар появляется лишь на 50%, а затем завершается, т.е. я вижу только 50% и все а более точно какой % сейчас выполнен не вижу. Ну так же не правильно, мне нужно видеть сколько выполнено. Ну да ладно.......  
 
А не подскажешь а можно ли сделать так, как я хотел с самого начала, т.е. кол-во проверяемых строк мне известно, я делю это кол-во на 100 и получаю кол-во проверенных строк на каждые 10%, и чтобы когда процесс проверки скрытия строк дошел до определенной строки или ячейки в этой строке ,чтобы в этот момент excel перешел на ячейку с экраном где у меня нарисовано выполнение с нужным процентом и так по 10 картинок на каждые 10%...  
Так нельзя никак сделать ???
 
 
 
#12
18.01.2011 13:10:22
Что-то много текста... :)  
Можно просто активировать например А1, тупо занести в неё данные и показать/скрыть экран, потом поменять данные и снова показать/скрыть экран...
 
 
 
#13
18.01.2011 13:19:03
{quote}{login=Hugo}{date=18.01.2011 01:10}{thema=}{post}Что-то много текста... :)  
Можно просто активировать например А1, тупо занести в неё данные и показать/скрыть экран, потом поменять данные и снова показать/скрыть экран...{/post}{/quote}  
 
А не подскажете а нельзя сделать так, стобы процесс сначала выполнил проверку строк от А1 до А15 и перешел на ячейку где я нарисовал 10%, а затем проверил промежуток от А11 до А30 и так далее ..... ????
 
 
 
#14
18.01.2011 13:30:57
Может тогда так:  
 
Sub test5()  
Dim x As Long, iLastrow As Long, p As Long, s As String  
Application.ScreenUpdating = False  
 
iLastrow = Columns("A:A").SpecialCells(xlLastCell).Row  
 
For x = 1 To iLastrow  
If Cells(x, 1) = 0 Then Rows(x).Hidden = True  
If x Mod 100 = 0 Then  
[a1] = x \ iLastrow / 100 & "%"
Application.ScreenUpdating = True  
Application.ScreenUpdating = False  
End If  
Next  
 
Application.ScreenUpdating = True  
Application.StatusBar = False  
End Sub  
 
Только сперва активировать А1, чтоб видно было.
 
 
 
#15
18.01.2011 13:40:16
Так у Вас всего 150 строк проверяется? Стоит из-за этого огород городить?  
Может просто отключить на это время пересчёт формул, если они тормозят, и всё?
 
 
 
#16
18.01.2011 13:59:10
Вот весь ваш макрос:  
 
Sub test()  
   On Error Resume Next  
   Dim ra As Range, HiddenRange As Range: Application.ScreenUpdating = False  
   For Each ra In Range("a:a").SpecialCells(xlCellTypeConstants)  
       If Val(ra) = 0 Then  
           If HiddenRange Is Nothing Then Set HiddenRange = ra Else Set HiddenRange = Union(HiddenRange, ra)  
       End If  
   Next  
   If Not HiddenRange Is Nothing Then HiddenRange.EntireRow.Hidden = True  
End Sub  
 
 
И никакой прогресс-бар нафиг не нужен - код выполняется за долю секунды  
(скрываются все нулевые строки одновременно)  
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__18-01-2011__15-58-58.zip
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#17
18.01.2011 14:55:21
Только Union на каком-то количестве строк загибался... Совсем недавно было.
 
 
 
#18
18.01.2011 15:03:38
{quote}{login=EducatedFool}{date=18.01.2011 01:59}{thema=}{post}Вот весь ваш макрос:  
 
Sub test()  
   On Error Resume Next  
   Dim ra As Range, HiddenRange As Range: Application.ScreenUpdating = False  
   For Each ra In Range("a:a").SpecialCells(xlCellTypeConstants)  
       If Val(ra) = 0 Then  
           If HiddenRange Is Nothing Then Set HiddenRange = ra Else Set HiddenRange = Union(HiddenRange, ra)  
       End If  
   Next  
   If Not HiddenRange Is Nothing Then HiddenRange.EntireRow.Hidden = True  
End Sub  
 
 
И никакой прогресс-бар нафиг не нужен - код выполняется за долю секунды  
(скрываются все нулевые строки одновременно)  
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__18-01-2011__15-58-58.zip{/post}{/quote}  
 
У вас в примере уже введены значения без формул, а у меня эти значения вычисляются по формулам, т.е. начинается с "=" =0 или =1.  
и как тогда мне здесь быть, то-то здесь нужно подправить, а что ????  
ПОДСКАЖИТЕ !!!!
 
 
 
#19
18.01.2011 15:36:08
замените строку  
For Each ra In Range("a:a").SpecialCells(xlCellTypeConstants)  
 
на  
For Each ra In Range("a:a").SpecialCells(xlCellTypeFormulas)  
 
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__18-01-2011__17-35-46.zip
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#20
18.01.2011 15:40:41
{quote}{login=EducatedFool}{date=18.01.2011 03:36}{thema=}{post}замените строку  
For Each ra In Range("a:a").SpecialCells(xlCellTypeConstants)  
 
на  
For Each ra In Range("a:a").SpecialCells(xlCellTypeFormulas)  
 
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__18-01-2011__17-35-46.zip{/post}{/quote}  
 
ВСЕ ТЕПЕРЬ ВСЕ БЫСТРО И НЕ НУЖНО ЖДАТЬ СУПЕР СПАСИБО !!!!!!!!!!!!
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...