Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Замена с одного кода на другой в каждой книге с помощью макроса
 
#1
26.06.2026 13:37:32
Добрый день всем!

Вопрос творческий и сложный:
Был разработан код с помощью макроса для автоматической замены буквы во всех книгах с разными именами на листе с одним и тем же именем.
Задача состоит в том, что макрос ищет соответствующий символ и заменяет его на другой символ автоматически. Например, в книгах "Работа 1" и "Работа 2" на одном и том же листе "Отчёт" ищет символы А и Б, затем находит и заменяет его на П.
Это был разработан, но ничего не произошло. Я не гуру, чтобы разобраться более сложную задачу. Прошу помочь, чего не хватает для полноценной работы? Может кнопку добавить и немного перезаписать код? Буду очень благодарен.
 
 
 
#2
26.06.2026 15:45:09
Цитата
написал:
Может кнопку добавить и немного перезаписать код
Добрый день. "Посмотрел" Ваш код. Все четко, красиво и корректно.

Цитата
написал:
Прошу помочь, чего не хватает для полноценной работы?
Не хватает шашлычка)))
 
 
 
#3
26.06.2026 16:22:42
Цитата
написал:
Прошу помочь, чего не хватает для полноценной работы?
не хватает файла(ов) от Вас, согласно Правил форума...
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
 
 
#4
26.06.2026 19:36:46
Странно, что не загрузились. Повторно направляю:)
 
 
 
#5
26.06.2026 19:58:32
Ох уж этот ИИ.
Замените If Left(nm.RefersTo, Len("'" & TARGET_SHEET_NAME & "'!")) = "'" & TARGET_SHEET_NAME & "'!" Then
на  If InStr(1, nm.RefersTo, "=" & TARGET_SHEET_NAME & "!", vbTextCompare) = 1 Then
 
 
 
#6
29.06.2026 15:43:21
Добрый день!
Благодарю за совет, но я нашел другой способ, как автоматически открыть книгу эксель и заменить подстрочную букву на другую. Но возник вопрос:

Хочу перезаписать код Replace What для поиска и замены сразу несколько букв.
Например, вместо Cells.Replace What:="I-EA", Replacement:="C", _ написать Cells.Replace What:="I-EA", "A", "B", "F" и т.д., Replacement:="C", _ (это я примерно написал, чтобы поняли)

Присылаю код и помечу красным цветом, где необходимо изменить:

Sub OpenAllExcelFilesInFolder()
   Dim sFolder As String
   Dim sFile As String
   Dim wb As Workbook

   ' Открываем диалоговое окно для выбора папки
   With Application.FileDialog(msoFileDialogFolderPicker)
       If .Show = False Then Exit Sub ' Пользователь отменил выбор
       sFolder = .SelectedItems(1)
   End With

   ' Убеждаемся, что путь заканчивается на обратный слеш
   sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

   ' Перебираем файлы
   sFile = Dir(sFolder & "*.xlsx") ' Меняйте расширение, если нужны другие форматы (например, *.xls)
   Do While sFile <> ""
       ' Открываем книгу
       Set wb = Application.Workbooks.Open(sFolder & sFile)

       ' Здесь можно добавить код, который будет выполняться с каждой книгой
       ' Например: записать что-то в ячейку, запустить макрос, сохранить и закрыть
       Cells.Replace What:="I-EA", Replacement:="C", _
       LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

       ' Закрываем книгу без сохранения изменений (если не нужно сохранять)
       wb.Close SaveChanges:=True

       ' Переходим к следующему файлу
       sFile = Dir
   Loop

   ' Восстанавливаем обновление экрана, если оно было отключено
   Application.ScreenUpdating = True
End Sub
 
 
 
#7
29.06.2026 15:56:08
Цитата
romlel написал: Например, вместо Cells.Replace What:="I-EA", Replacement:="C", _ написать Cells.Replace What:="I-EA", "A", "B", "F" и т.д.,
Так не работает. Нужно каждый заменяемый символ прописывать отдельной строкой
Например так
Код
With Cells
    .Replace What:="I-EA", Replacement:="C"
    .Replace What:="A", Replacement:="C"
    .Replace What:="B", Replacement:="C"
    'и т.д.
End With

Если замен много, то можно циклом.
Например
Код
arr = Array("I-EA", "A", "B", "F")
For Each iSym In arr
    Cells.Replace What:=iSym, Replacement:="C"
Next

Или использовать вложенные функции Replace
Изменено: Sanja - 29.06.2026 15:58:26
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
29.06.2026 15:58:19
Понял, благодарю за оперативный ответ:)
 
 
 
#9
29.06.2026 18:00:59
Еще такой вопрос.

Я протестировал, получилось прекрасно, но возникла небольшая проблема.

Например, задача заменить букву с С2 на I-EA, но макрос не делает этого, вместо I-EA заменяет на I-EA2, а я не хочу этого.
Я искал все, что мог. Не получается.
Я прописал код:
 
        .Replace What:="LR2", Replacement:=Left("I-EA", 4), _
       LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

А выдает результат I-EA2 или I-EA3

Присылаю код и помечу красным цветом, где необходимо изменить:
Код
Sub OpenAllExcelFilesInFolder()
   Dim sFolder As String
   Dim sFile As String
   Dim wb As Workbook

   ' Открываем диалоговое окно для выбора папки
   With Application.FileDialog(msoFileDialogFolderPicker)
       If .Show = False Then Exit Sub ' Пользователь отменил выбор
       sFolder = .SelectedItems(1)
   End With

   ' Убеждаемся, что путь заканчивается на обратный слеш
   sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

   ' Перебираем файлы
   sFile = Dir(sFolder & "*.xlsx") ' Меняйте расширение, если нужны другие форматы (например, *.xls)
   Do While sFile <> ""
       ' Открываем книгу
       Set wb = Application.Workbooks.Open(sFolder & sFile)

       ' Здесь можно добавить код, который будет выполняться с каждой книгой
       ' Например: записать что-то в ячейку, запустить макрос, сохранить и закрыть
        With wb.Worksheets("???????").Cells
        .Replace What:="AP", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="LR", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="C", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="LR2", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="C2", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="LR3", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        .Replace What:="C3", Replacement:=Left("I-EA", 4), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    End With

       ' Закрываем книгу без сохранения изменений (если не нужно сохранять)
       wb.Close SaveChanges:=True

       ' Переходим к следующему файлу
       sFile = Dir
   Loop

   ' Восстанавливаем обновление экрана, если оно было отключено
   Application.ScreenUpdating = True
End Sub
Изменено: romlel - 29.06.2026 22:19:33
 
 
 
#10
29.06.2026 18:08:53
Вы видели как оформлен код в моем сообщении?
Используйте кнопку <...> на панели инструментов
Исправьте свои сообщения
И файл-пример желательно прикладывать
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
29.06.2026 18:35:27
Цитата
написал:
With wb.Worksheets("???????").Cells
       ....
       .Replace What:="C", Replacement:=Left("I-EA", 4), _
       LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
       .Replace What:="C2", Replacement:=Left("I-EA", 4), _
       LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
вот здесь проблема - Вы сначала заменяете "С" на "I-EA", а потом пытаетесь заменить "С2", "С3" и т.д. Но "С" уже нет - она заменена на "I-EA".
Т.е. надо сначала заменять самые длинные сочетания, а потом уже те, что короче. Иначе говоря - от большего кол-ва символов в искомом значении до меньшего. И Left("I-EA", 4) - бред полный.
Ну и лучше просто циклом это делать:
Код
Dim x
With wb.Worksheets("???????").Cells
    For each x in array("LR3", "LR2","LR", "AP", "C3", "C2", "C")
         .Replace What:=x, Replacement:="I-EA",  LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Next
End With
далее можно просто добавлять через запятую нужные значения для замены(соблюдая описанную выше последовательность по кол-ву символов).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#12
29.06.2026 22:20:21
Цитата
написал:
Вы видели как оформлен код в моем сообщении?Используйте кнопку   на панели инструментовИсправьте свои сообщенияИ файл-пример желательно прикладывать
Понял, благодарю за подсказку, исправил:)
 
 
 
#13
29.06.2026 22:21:50
Цитата
написал:
Т.е. надо сначала заменять самые длинные сочетания, а потом уже те, что короче. Иначе говоря - от большего кол-ва символов в искомом значении до меньшего. И Left("I-EA", 4) - бред полный.
Теперь стало ясно. Благодарю за помощь, буду применять.
 
 
 
#14
08.07.2026 15:49:30
Добрый день всем!

Возникла проблема при замене букв.
Проблема в том, что макрос ищет и заменяет все вхождения буквы в тексте, а не только те случаи, когда она стоит в слове целиком. Из-за этого в слове, например, «привет» буква «п» тоже меняется — макрос не различает контекст. Что нужно добавить, чтобы макрос различал контекст?
Код
Dim x
With wb.Worksheets("Матрица дистрибуции").Cells
    For Each x In Array("LR3", "LR2", "LR", "AP", "C3", "C2", "C")
         .Replace What:=x, Replacement:="I-EA", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Next
End With

 
 
 
#15
08.07.2026 16:01:36
Все, решен вопрос:)
Нашел способ, просто заменить с LookAt:=xlPart на LookAt:=xlWhole
 
 
 
Страницы: 1
Читают тему
Наверх