ReplaceTabValuesUsingMask
Заменяет значения по маскеuser_2065311
vbscript
a year ago
3.6 kB
2
Indexable
```
ReplaceTabValuesUsingMask
Описание:
Этот макрос выполняет замены значений в столбцах таблиц в активной книге на основе маски замены, заданной пользователем. Пользователь выбирает диапазон с маской, где каждая строка указывает на лист, столбец, исходное значение и новое значение для замены. Макрос проходит по каждому указанному листу и столбцу и заменяет значения на новые. Если лист не найден, макрос пропускает соответствующую строку и продолжает выполнение. В конце выводится сообщение об успешной замене значений.
```
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 SubEditor is loading...
Leave a Comment