VBA Marco 我需要在多个列上运行 FindAndReplace

Question

我是 VBA 新手，所以请耐心等待。

我有一本包含多张纸的工作簿。第一张表“feedbacktask”包含我想要使用的数据，而其他表是我想要用于查找和替换操作的列表。

我已成功运行子程序，将第一张表（“Feedbacktask”）中的一列（E）中的数据替换为其他表“Payroll”和“askHR”中的数据。现在，我需要使用“作者列表”表中的数据在“反馈任务”表的另一列 (N) 中执行查找和替换。

我该怎么做？

这就是到目前为止的样子，但它给了我一条错误消息。如果我只对一列（E）运行它，它就会起作用，并将列（E）中的文本替换为工作表“Payroll”和“askHR”中列表中的文本：

Sub FindAndReplace()

    Dim FeedbacktaskWorksheet As Worksheet
    Dim searchRange As Range
    Dim replaceTable As Variant
    Dim findWhat As String
    Dim replaceWith As String
    Dim i As Long
    
    Set FeedbacktaskWorksheet = ThisWorkbook.Worksheets("Feedbacktask")
    
    With FeedbacktaskWorksheet
        Set searchRange = .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
    End With
            
    With ThisWorkbook.Worksheets("askHR DK")
        replaceTable = .Range("A1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
    
    With ThisWorkbook.Worksheets("Payroll")
        replaceTable = .Range("A1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
   
    Set FeedbacktaskWorksheet = ThisWorkbook.Worksheets("Feedbacktask")
    
    With FeedbacktaskWorksheet
        Set searchRange = .Range("N2:N" & .Cells(.Rows.Count, "E").End(xlUp).Row)
    End With
            
    With ThisWorkbook.Worksheets("Author list")
        replaceTable = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
     
    For i = 1 To UBound(replaceTable)
        findWhat = replaceTable(i, 1)
        replaceWith = replaceTable(i, 2)
        searchRange.Replace _
            What:=findWhat, _
            replacement:=replaceWith, _
            lookat:=xlPart, _
            MatchCase:=False
    Next i
    
End Sub

Answer 1

每当您有重复性任务时，最好将其放入单独的方法中。 稍微重构一下你的代码，它可以像这样工作：

Sub FindAndReplace()

    Dim FeedbacktaskWorksheet As Worksheet, wb As Workbook
    
    Set wb = ThisWorkbook
    Set FeedbacktaskWorksheet = wb.Worksheets("Feedbacktask")
    
    With FeedbacktaskWorksheet
        'replacing col E values with list from "askHR DK"
        ReplaceList .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row), _
                    wb.Worksheets("askHR DK").Range("A1")
        
        'replacing col F values with list from "Payroll"
        ReplaceList .Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row), _
                    wb.Worksheets("Payroll").Range("A1")
                    
        'replacing col N values with list from "Author list"
        ReplaceList .Range("N2:N" & .Cells(.Rows.Count, "N").End(xlUp).Row), _
                    wb.Worksheets("Author list").Range("A2")
                    
    End With
            
End Sub

'replace content in `searchrange` using list of pairs of values in 2D array `replaceTable`
Sub ReplaceList(searchRange As Range, replaceTable)
    Dim i As Long
    For i = 1 To UBound(replaceTable, 1) 'loop over pairs of values
        searchRange.Replace _
            What:=replaceTable(i, 1), _
            Replacement:=replaceTable(i, 2), _
            lookat:=xlPart, _
            MatchCase:=False
    Next i
End Sub

'return a 2D array from range starting at `c` to the end of data in same column
Function GetList(c As Range) As Variant
    With c.Parent
        GetList = .Range(c, .Cells(.Rows.Count, c.Column).End(xlUp)).Resize(, 2).Value
    End With
End Function