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

Вход

Регистрация

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

 

= Мир MS Excel/Удалить из всей книги символ рубля и очистить ячейки по усл. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить из всей книги символ рубля и очистить ячейки по усл. (Макросы/Sub)
Удалить из всей книги символ рубля и очистить ячейки по усл.
lamak58 Дата: Среда, 22.06.2016, 16:56 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
есть вот такой код
[vba]
Код
Sub POLIS()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
r.MergeCells = False
r.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142)   Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

вопрос - можно ли переделать его,чтобы Excel считал не по ячейкам а как массивы?а то слишком медленно выполняется данный код при больших объемах обработки.


Сообщение отредактировал lamak58 - Среда, 22.06.2016, 16:57
 
Ответить
Сообщениеесть вот такой код
[vba]
Код
Sub POLIS()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
r.MergeCells = False
r.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142)   Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

вопрос - можно ли переделать его,чтобы Excel считал не по ячейкам а как массивы?а то слишком медленно выполняется данный код при больших объемах обработки.

Автор - lamak58
Дата добавления - 22.06.2016 в 16:56
abtextime Дата: Среда, 22.06.2016, 17:09 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Наверное, прежде всего
Application.ScreenUpdating = False

Ну и так далее ... http://vba.valemak.com/vba/macros/accelerates-the-macros/

На каких объемах тормозит и как сильно?
 
Ответить
СообщениеНаверное, прежде всего
Application.ScreenUpdating = False

Ну и так далее ... http://vba.valemak.com/vba/macros/accelerates-the-macros/

На каких объемах тормозит и как сильно?

Автор - abtextime
Дата добавления - 22.06.2016 в 17:09
lamak58 Дата: Среда, 22.06.2016, 17:18 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
ой,извиняюсь,забыл добавить что Call Prepare , Call Ended у меня вызывают уже вот это
[vba]
Код
Public Sub Prepare()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
Dim r As Range
Dim rgn As Range
End Sub
Public Sub Ended()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub
[/vba]
 
Ответить
Сообщениеой,извиняюсь,забыл добавить что Call Prepare , Call Ended у меня вызывают уже вот это
[vba]
Код
Public Sub Prepare()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
Dim r As Range
Dim rgn As Range
End Sub
Public Sub Ended()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub
[/vba]

Автор - lamak58
Дата добавления - 22.06.2016 в 17:18
lamak58 Дата: Среда, 22.06.2016, 17:25 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
На каких объемах тормозит и как сильно?


более 10 страниц в одной книге уже почти минуту надо ждать,а если увеличить кол- во цветов то время еще увеличится <_<
 
Ответить
Сообщение
На каких объемах тормозит и как сильно?


более 10 страниц в одной книге уже почти минуту надо ждать,а если увеличить кол- во цветов то время еще увеличится <_<

Автор - lamak58
Дата добавления - 22.06.2016 в 17:25
abtextime Дата: Среда, 22.06.2016, 17:35 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Не знаю, насколько поможет, но логично Cells.ClearContents и r.Cells.Replace вынести в один if-then-else

Ну и, по-хорошему, Вы бы хоть написали, что делает Ваш макрос.


Сообщение отредактировал abtextime - Среда, 22.06.2016, 17:38
 
Ответить
СообщениеНе знаю, насколько поможет, но логично Cells.ClearContents и r.Cells.Replace вынести в один if-then-else

Ну и, по-хорошему, Вы бы хоть написали, что делает Ваш макрос.

Автор - abtextime
Дата добавления - 22.06.2016 в 17:35
lamak58 Дата: Среда, 22.06.2016, 17:44 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
1.ищет по всей активной книге символ рубля и удаляет его
2.очищает содержимое всех ячеек,индекс цвета которых не равен 38 , -4142 .
 
Ответить
Сообщение1.ищет по всей активной книге символ рубля и удаляет его
2.очищает содержимое всех ячеек,индекс цвета которых не равен 38 , -4142 .

Автор - lamak58
Дата добавления - 22.06.2016 в 17:44
abtextime Дата: Среда, 22.06.2016, 17:57 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
10 страниц (страниц? или листов?)- ладно ... ячеек-то сколько? Может, у Вас UsedRange сильно большой на каких-то листах?

В самом коде не особо что тормозить должно. Оптимизировать можно, но на полшишечки. ИМХО, конечно, если что - мэтры поправят


Сообщение отредактировал abtextime - Среда, 22.06.2016, 17:57
 
Ответить
Сообщение10 страниц (страниц? или листов?)- ладно ... ячеек-то сколько? Может, у Вас UsedRange сильно большой на каких-то листах?

В самом коде не особо что тормозить должно. Оптимизировать можно, но на полшишечки. ИМХО, конечно, если что - мэтры поправят

Автор - abtextime
Дата добавления - 22.06.2016 в 17:57
lamak58 Дата: Среда, 22.06.2016, 18:00 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Может, у Вас UsedRange сильно большой на каких-то листах?

да,в этом основной трабл
в некоторых листах колво строк гдето 15к и более,и макрос я так понимаю по всем ячейкам смотрит.
 
Ответить
Сообщение
Может, у Вас UsedRange сильно большой на каких-то листах?

да,в этом основной трабл
в некоторых листах колво строк гдето 15к и более,и макрос я так понимаю по всем ячейкам смотрит.

Автор - lamak58
Дата добавления - 22.06.2016 в 18:00
Manyasha Дата: Среда, 22.06.2016, 18:27 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
lamak58, вот так попробуйте: поиск и замену не обязательно в каждой ячейке отдельно делать, можно сразу на всем листе. С объединенными ячейками тоже.
[vba]
Код
Sub POLIS()
    Call Prepare
    'For Each sh In ActiveWorkbook.Sheets
        Set rgn = sh.UsedRange
        rgn.Cells.UnMerge
        rgn.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        For Each r In rgn.Cells
            If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
                r.Cells.ClearContents
            End If
        Next
    'Next
    Call Ended
End Sub
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlamak58, вот так попробуйте: поиск и замену не обязательно в каждой ячейке отдельно делать, можно сразу на всем листе. С объединенными ячейками тоже.
[vba]
Код
Sub POLIS()
    Call Prepare
    'For Each sh In ActiveWorkbook.Sheets
        Set rgn = sh.UsedRange
        rgn.Cells.UnMerge
        rgn.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        For Each r In rgn.Cells
            If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
                r.Cells.ClearContents
            End If
        Next
    'Next
    Call Ended
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 22.06.2016 в 18:27
nilem Дата: Среда, 22.06.2016, 18:49 | Сообщение № 10
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
почти так же, но раз уж нарисовал:
[vba]
Код
Sub ertert()
Dim sh As Worksheet, r As Range

With Application.FindFormat
    .Clear
    .Interior.Color = 65535    ' желтый
End With

For Each sh In ActiveWorkbook.Sheets
    With sh.UsedRange
        .MergeCells = False
        .Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart
        Set r = .Find("*", SearchFormat:=True)
        If Not r Is Nothing Then
            Do
                r.ClearContents
                Set r = .Find("*", after:=r, SearchFormat:=True)
            Loop While Not r Is Nothing
        End If
    End With
Next sh
Application.FindFormat.Clear
End Sub
[/vba]


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Среда, 22.06.2016, 18:51
 
Ответить
Сообщениепочти так же, но раз уж нарисовал:
[vba]
Код
Sub ertert()
Dim sh As Worksheet, r As Range

With Application.FindFormat
    .Clear
    .Interior.Color = 65535    ' желтый
End With

For Each sh In ActiveWorkbook.Sheets
    With sh.UsedRange
        .MergeCells = False
        .Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart
        Set r = .Find("*", SearchFormat:=True)
        If Not r Is Nothing Then
            Do
                r.ClearContents
                Set r = .Find("*", after:=r, SearchFormat:=True)
            Loop While Not r Is Nothing
        End If
    End With
Next sh
Application.FindFormat.Clear
End Sub
[/vba]

Автор - nilem
Дата добавления - 22.06.2016 в 18:49
abtextime Дата: Среда, 22.06.2016, 19:00 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
в некоторых листах колво строк гдето 15к

а это какие-то виртуальные, неправильные 15к? или реальные?
 
Ответить
Сообщение
в некоторых листах колво строк гдето 15к

а это какие-то виртуальные, неправильные 15к? или реальные?

Автор - abtextime
Дата добавления - 22.06.2016 в 19:00
lamak58 Дата: Четверг, 23.06.2016, 11:18 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
а это какие-то виртуальные, неправильные 15к? или реальные?

да пустые они .
всем спасибо,ща пойду тестить :)


Сообщение отредактировал lamak58 - Четверг, 23.06.2016, 11:24
 
Ответить
Сообщение
а это какие-то виртуальные, неправильные 15к? или реальные?

да пустые они .
всем спасибо,ща пойду тестить :)

Автор - lamak58
Дата добавления - 23.06.2016 в 11:18
lamak58 Дата: Четверг, 23.06.2016, 11:52 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
lamak58, вот так попробуйте: поиск и замену не обязательно в каждой ячейке отдельно делать, можно сразу на всем листе. С объединенными ячейками тоже.

вау,просто заменил полторы строчки,и работа ускорилась в разы,огромное спасибо :o

upd.хм, насчет выводов я поспешил.на приложенном файле попробовал две версии кода,
[vba]
Код
Sub POLIS2()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
r.MergeCells = False
r.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

и

[vba]
Код
Sub POLIS()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
rgn.Cells.UnMerge
rgn.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

POLIS 2 оказался быстрее ,ничего не понимаю.... %)
[moder]У меня пишет, что архив поврежден или имеет неизвестный формат.[/moder]
К сообщению приложен файл: _1-11-.rar (21.7 Kb)


Сообщение отредактировал Manyasha - Пятница, 24.06.2016, 10:00
 
Ответить
Сообщение
lamak58, вот так попробуйте: поиск и замену не обязательно в каждой ячейке отдельно делать, можно сразу на всем листе. С объединенными ячейками тоже.

вау,просто заменил полторы строчки,и работа ускорилась в разы,огромное спасибо :o

upd.хм, насчет выводов я поспешил.на приложенном файле попробовал две версии кода,
[vba]
Код
Sub POLIS2()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
r.MergeCells = False
r.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

и

[vba]
Код
Sub POLIS()
Call Prepare
For Each sh In ActiveWorkbook.Sheets
Set rgn = sh.UsedRange
For Each r In rgn.Cells
rgn.Cells.UnMerge
rgn.Cells.Replace What:=ChrW(8381), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
If (r.Cells.Interior.ColorIndex <> 38) And (r.Cells.Interior.ColorIndex <> -4142) Then
r.Cells.ClearContents
End If
Next
Next
Call Ended
End Sub
[/vba]

POLIS 2 оказался быстрее ,ничего не понимаю.... %)
[moder]У меня пишет, что архив поврежден или имеет неизвестный формат.[/moder]

Автор - lamak58
Дата добавления - 23.06.2016 в 11:52
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить из всей книги символ рубля и очистить ячейки по усл. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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