МассоваяЗаменЗначТаб
Заменяет значения по маскеuser_2065311
vbscript
5 months ago
2.7 kB
2
Indexable
Sub ReplaceValuesBasedOnMask_ActiveWorkbook() Dim replaceRange As Range Dim replaceCell As Range Dim ws As Worksheet Dim columnIndex As Long Dim replaceValue As String Dim newValue As String Dim wb As Workbook ' Устанавливаем активную книгу Set wb = ActiveWorkbook ' Попросить пользователя выделить диапазон с маской замены On Error Resume Next Set replaceRange = Application.InputBox("Выделите диапазон данных с маской замены (Маска_без_заголовков: Лист, Номер столбца, Значение, Замена):", Type:=8) If replaceRange Is Nothing Then MsgBox "Диапазон не выбран. Работа макроса завершена.", vbExclamation Exit Sub End If On Error GoTo 0 ' Проходим по каждому ряду в выделенном диапазоне For Each replaceCell In replaceRange.Rows ' Считываем данные из текущей строки On Error Resume Next Set ws = wb.Worksheets(replaceCell.Cells(1, 1).Value) If ws Is Nothing Then MsgBox "Лист '" & replaceCell.Cells(1, 1).Value & "' не найден. Пропуск строки.", vbExclamation GoTo NextIteration End If On Error GoTo 0 ' Получаем номер столбца (может быть числом или буквой) If IsNumeric(replaceCell.Cells(1, 2).Value) Then columnIndex = replaceCell.Cells(1, 2).Value Else columnIndex = Columns(replaceCell.Cells(1, 2).Value).Column End If ' Получаем значение для замены и новое значение replaceValue = replaceCell.Cells(1, 3).Value newValue = replaceCell.Cells(1, 4).Value ' Проходим по всем ячейкам в указанном столбце и выполняем замену Dim cell As Range For Each cell In ws.Columns(columnIndex).Cells If cell.Value = replaceValue Then cell.Value = newValue End If Next cell NextIteration: ' Сбрасываем ссылку на лист для следующей итерации Set ws = Nothing Next replaceCell ' Сообщение об окончании работы MsgBox "Замены значений успешно выполнены.", vbInformation End Sub
Editor is loading...