Question

我有两张纸。在第一列是一个列，其中包括“一”，“一+两”，“onetwo +三”等。第二列是两列，第一列有“查找”部分，第二列有“替换”部分（例如A栏中的“一”和B栏中的“1”）

我想使用宏进行查找和替换，以便它只使用第二张表中的替换键替换“+”字符前面找到的内容。我希望得到“1”，“1 + 2”，“12 + 3”作为结果。

我目前正在使用我在其他地方找到的这个

    Sub multiFindandReplace()

    Dim myList As Range, myRange As Range, cel As Range

    Set myList = Sheets("sheet2").Range("A1:B20")     'two column range with find/replace pairs
    Set myRange = Sheets("sheet1").Range("A1:A20") 'range to be searched and replace
    For Each cel In myList.Columns(1).Cells
        myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 1).Value, LookAt:=xlPart
    Next cel

    End Sub

除了仅影响“+”之前的单元格部分外，它会执行所有操作。

谢谢！

Answer 1

另一种方法可以是将替换值存储到数组中并循环遍历它们。

此示例将所有单元格文本按+拆分为数组，然后在数组的第一个元素上运行Replace。

Sub ReplaceTest()

Dim replaceRange() As Variant
Dim replaceSht As Worksheet
Dim marker As String
Dim myRange As Range, values As Variant
Dim firstReplacementColumn As Long
Dim replaceEndRow As Long

'this is the sheet that the replacement values are in
Set replaceSht = Sheet1

'first replacement column is "A"
'(so the values to replace will be in the next column "B")
firstReplacementColumn = 1

'range that we want to replace
Set myRange = Sheets("sheet1").Range("E1:E6")

'what we want to match in our string
marker = "+"

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'get end row of the replacements
replaceEndRow = replaceSht.Cells(replaceSht.Rows.Count, firstReplacementColumn).End(xlUp).Row

'add all the replacements into an array
ReDim replaceRange(1 To replaceEndRow, 1 To 2)
replaceRange = replaceSht.Range(replaceSht.Cells(1, firstReplacementColumn) _
                                , replaceSht.Cells(replaceEndRow, firstReplacementColumn + 1)).Value2


    'cycle through our range of stuff we want to check and replace
    For Each cell In myRange

    'split the values on + to an array
    values = Split(cell.Value, marker)

        'if the value has been split then there must be at least 1 + in the string
        If UBound(values) > 0 Then

            'loop through all the replacement array and replace
            For i = LBound(replaceRange) To UBound(replaceRange)
            'we're only interested in doing replaces before the first + (so just values(0))
            values(0) = Replace(values(0), replaceRange(i, 1), replaceRange(i, 2))
            Next i

        cell.Value = Join(values, marker)

        End If

    Next cell

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Exit Sub
err:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox err.Description, vbCritical, "An error occured"

End Sub

在某个角色之前替换（多个事物）

1 个答案: