﻿Sub Regreplace_list()
    Dim iRow As Integer
    Dim iRow2 As Integer
    Dim colorIndex As Integer
    Dim regEx   As New RegExp
    Dim shearch_str As String
    
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
        
    With ActiveSheet
        For iRow = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
            Set cel = Cells(iRow, 1)
next_op2:
            If cel.Column < .Columns("AQ").Column Then
                strTmp = LTrim(cel.Value)
                If strTmp <> "" Then
                    For iRow2 = 1 To ThisWorkbook.Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Row
                        colorIndex = ThisWorkbook.Sheets(2).Cells(iRow2, 1).Interior.colorIndex
                        If colorIndex <> 2 And colorIndex <> xlColorIndexNone Then
                            search_str = ThisWorkbook.Sheets(2).Cells(iRow2, 1).Value
                            If search_str <> "" Then
                                regEx.Pattern = search_str
                                If regEx.Test(strTmp) Then
                                    strTmp = regEx.Replace(strTmp, ThisWorkbook.Sheets(2).Cells(iRow2, 2).Value)
                                    'Exit For
                                End If
                            End If
                        End If
                    Next
                    cel.Value = strTmp
                    With cel.Font
                        .Name = "宋体"
                        .Size = 16
                    End With
                End If
                Set cel = cel.End(xlToRight)
                GoTo next_op2
            End If
        Next
    End With
End Sub
