ReplaceTabValuesUsingMask

Заменяет значения по маске
 avatar
user_2065311
vbscript
5 months ago
3.6 kB
0
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 Sub
Editor is loading...
Leave a Comment