Страницы: 1
RSS
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Здравствуйте, не поможете, есть макрос для редизайна таблицы, но в Ексель около 10-15 листов, не получается написать макрос, чтоб мой макрос выполнялся на всех листах. Буду благодарен за помощь. (макрос, который я пытался сделать для выполнения на всех листах)
Код
for I=1 to sheets.count
if worksheets(i).name<> ""then

end if
next I
Изменено: gefy 444 - 27.05.2022 13:32:02
 
и что ваш макрос должен делать? не считая прохода по листам.
Ваш только проверяет имя листа и ничего не делает.
П.С. Имя листа не может быть пустым.
Изменено: V - 27.05.2022 11:25:39
 
Цитата
написал:
и что ваш макрос должен делать? не считая прохода по листам.Ваш только проверяет имя листа и ничего не делает.П.С. Имя листа не может быть пустыОбщ
Общая идея, чтобы макрос выполнялся на всех листа сразу, а не проходить по каждому из них. Вот хотел модернизировать.
 
Насколько я знаю, "на всех листах сразу" - так нельзя. Это примерно как ехать на автомобиле одновременно на работу, в отпуск к морю, в магазин за новым креслом и на рынок за мангалом.
Сначала одно, потом другое. Сначала один объект (лист), потом другой.
Насколько я знаю. :)
Кому решение нужно - тот пример и рисует.
 
Цитата
написал:
Насколько я знаю, "на всех листах сразу" - так нельзя. Это примерно как ехать на автомобиле одновременно на работу, в отпуск к морю, в магазин за новым креслом и на рынок за мангалом.Сначала одно, потом другое. Сначала один объект (лист), потом другой.Насколько я знаю.
Это да, пусть последовательно. Просто сам факт, чтобы макрос проделывал все, не приходилось в ручную каждый лист запускать макрос.
 
Доброе утро,

позвольте присоединюсь с аналогичным вопросом.

Вчера пользовался макросом из интернета, вот этим.
Код
Sub MultiFindNReplace()
'Update 20140722
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Application.ScreenUpdating = True
End Sub
Он делает массовые замены в выбранном диапазоне по данным отдельного диапазона с значениями замен в двух столбцах. Вчера при исполнении применялся ко всем листам, а сегодня только к тому на котором выбираю диапазон где нужно сделать замены. В чем причина не могу понять. Правда вчера за компанию заменял и сам список соответствия. Помогите пожалуйста его запустить на всю книгу.
 
Цитата
Семен Владимиров написал:
В чем причина не могу понять
все просто - Вы диапазон указываете здесь:
Код
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

и он соответственно всегда и используется независимо от того, на каком листе Вы это хотите сделать. Чтобы подсказать как надо - надо понимать, что Вы вообще хотите и где заменять. Т.к. по коду я вообще не вижу даже намека на применение ко всем листам. Чисто в теории - можно попробовать так:
Код
Dim ws as worksheet
for each ws in activeworkbook.worksheets
For Each Rng In ReplaceRng.Columns(1).Cells
    ws.range(InputRng.address).Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
next
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
'можно добавить цикл пробега по всем листам 
'минимально изменяя ваш макрос можно как-то так:
For each ws in activebook.worksheets
ws.activate
With ActiveSheet        
Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)        
If Rng Is Nothing Then            
MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"            
Exit Sub        
End If        
firstAddres = Rng.Address        
Do            .Rows(Rng.Row).Copy            .Rows(Rng.Row + 1).Insert Shift:=xlDown            .Cells(Rng.Row + 1, 3) = ReplaceWord            
Set Rng = .Columns(3).FindNext(Rng)        
Loop Until Rng.Address = firstAddres    
End With    
Next
Кому решение нужно - тот пример и рисует.
 
Цитата
написал:
все просто - Вы диапазон указываете здесь:Код ? 1Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)и он соответственно всегда и используется независимо от того, на каком листе Вы это хотите сделать. Чтобы подсказать как надо - надо понимать, что Вы вообще хотите и где заменять. Т.к. по коду я вообще не вижу даже намека на применение ко всем листам. Чисто в теории - можно попробовать так:
Да, не понимаю как вчера оно работало на все листы.
Попробовал добавить Ваш фрагмент, но безуспешно. В этом макросе еще ж диапазоны задаются всплывающими окнами, и он получается каждый лист перезапрашивает. Или я что-то не так прописал. Может можно как-то прописать фиксированные диапазоны места замен и списка замен?
 
Цитата
Семен Владимиров написал:
Может можно как-то прописать фиксированные диапазоны места замен и списка замен?
присмотритесь к коду. Все что надо - заменить Ваши три строки:
Код
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next

предложенными мной. И все. И указать диапазоны надо будет только один раз.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
написал:
Все что надо - заменить Ваши три строки:

Я путаюсь в синтаксисе, сделал так

Код
Sub MultiFindNReplace()
'Update 20140722
Dim Rng As Range
Dim ws as worksheet
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
for each ws in activeworkbook.worksheets
For Each Rng In ReplaceRng.Columns(1).Cells
    ws.range(InputRng.address).Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Next
Application.ScreenUpdating = True
End Sub

Оно отработало в принципе, но в конце с ошибкой 13 type mismatch.

И некоторые замены сделались корректно, а часть нет. У меня есть замены слово на слово, там ок. А есть например артикулы типа Ф0000045644 меняются на ГФ0000045644. Там в результате получилось ГГГГГГГГГГГГГФ0000045644.          

 
Цитата
Семен Владимиров написал:
с ошибкой 13 type mismatch
нечего сказать. Файла нет, гадать не хочется. Может в списке ошибки какие.
Цитата
Семен Владимиров написал:
Там в результате получилось ГГГГГГГГГГГГГФ0000045644
это уже совершенно другая история. Логику работы своего кода надо настраивать :) Если замена идет по части текста, то вполне логично, что сначала надо продумать не будет ли одна замена перебивать другую. И только поняв и продумав все подобные варианты можно приступать к реализации кода.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
написал:
Код ? 12345678910111213141516'можно добавить цикл пробега по всем листам 'минимально изменяя ваш макрос можно как-то так:For each ws in activebook.worksheetsws.activateWith ActiveSheet        Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)        If Rng Is Nothing Then            MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"            Exit Sub        End If        firstAddres = Rng.Address        Do            .Rows(Rng.Row).Copy            .Rows(Rng.Row + 1).Insert Shift:=xlDown            .Cells(Rng.Row + 1, 3) = ReplaceWord            Set Rng = .Columns(3).FindNext(Rng)        Loop Until Rng.Address = firstAddres    End With    Next


Кому решение нужно - тот пример и рисует.
Я попытался сделать что то похожее с другим запросом, но тут ошибка. В чем я ошибся? Выше исписанный запрос, не подошел под требования, которые мне надо в таблице сделать.
 
Цитата
написал:
это уже совершенно другая история. Логику работы своего кода надо настраивать  Если замена идет по части текста, то вполне логично, что сначала надо продумать не будет ли одна замена перебивать другую. И только поняв и продумав все подобные варианты можно приступать к реализации кода.
Добавил
XlLookAt:=xlWhole
И вроде бы все как надо, и без ошибок теперь. Спасибо.
 
Цитата
Пытливый написал:
Насколько я знаю, "на всех листах сразу" - так нельзя.

В некоторых случаях можно. Выделите в документе более одного листа и выполните макрос:

Код
Sub Test()
  ActiveCell.Formula = "Planeta"
End Sub
Владимир
 
Неплохая идея, а как вот теперь, пусть даже если с выделением листов, запустить макрос нужный.
Изменено: gefy 444 - 27.05.2022 15:25:43
 
sokol92, можете подсказать, как в ваш макрос можно вписать мой, чтоб они вместе функционировали? Вместо Planeta как то вставить макрос или как
Код
Sub Test()
  ActiveCell.Formula = "Planeta"
End Sub
 
Такое работает только для простых случаев, не для Вашего.

На форуме не принято цитировать непосредственно предыдущий ответ, если только не надо акцентировать внимание на каком-то фрагменте ответа. Вы можете вернуться к своим сообщениям и удалить излишнее цитирование, все равно модераторы попросят это сделать.  :)
Владимир
 
sokol92, Удалил. Жалко, что для простых. Прост от макроса нужно, чтоб отработал на 1 листе под требуемые условия (которые задаются: размер таблицы, строки и столбцы), и по данным условиям дальше отработал по остальным листам  
 
gefy 444,
тут могут решить задачу, которую вы коротко и точно опишете, задачу, о которой вы все это время думаете никто не решит, потому что никто не знает о чем вы думаете
Изменено: Ігор Гончаренко - 27.05.2022 16:51:45
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Только начинаю изучать макросы.. Может кто подскажет, как реализовать следующую задачу:
Вот, например,  что имеем:
Дата                  01.07.2019
Касса Номер    0000000023
Покупатель       ООО Агат
сумма                550 000.00
Дата                  23.02.2020
Касса Номер    0000000025
Покупатель      ИП Карпенко
сумма               462 235.00
Дата                  12.12.2021
Касса Номер    0000000\12
Покупатель       ИП Лоскут
сумма               356 458.00
А нужно сделать вот такую форму:    Дата                  Касса номер      Покупатель      Сумма
                                                              01.07.2019        00000000023     ООО Агат         550 000.00
                                                              23.02.2020        00000000025     ИП Карпенко    462 235.00
                                                               12.12.2021       00000000012     ИП Лоскут         356 458.00
 
 
Alena Maksakova,
стартуйте новую тему, прикрепите в ней файл с данными
задача решается просто
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх