循环遍历列中要查找/替换的数组时出现"Subscript out of range"错误

Question

我在 excel 工作表上有两个名称列表(sh1 - Column A, Column D) .在另一个 excel 工作表(sh2 - Column B)上，我有另一个名称列表。我正在尝试用 D 列查找/替换 B 列上的 A 列名称。

我的完整代码列在底部。我在此行上收到"下标超出范围"错误：

Selection.Replace What:=fndArr(i), Replacement:=rplArr(i), LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False

我已经检查了范围，似乎代码应该遍历 sh2 列 B 中的每个单元格，寻找 A 列数据并将其替换为 D 列数据。

我对此完全空白。有谁知道为什么我会收到此错误？谢谢你的帮助。

Column A       |   Column B   |  Column D
--------------------------------------------
Hugh Jackman   |  Hugh J      |  Hugh Jackman
Ronald Reagan  |  Ronald R    |  Ronald Reagan
John Adams     |  John A      |  John Adams

.

Sub CheckReplace()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim fndArr() As Variant
Dim rplArr() As Variant
Set sh1 = Sheets("CA")
Set sh2 = Sheets("FD")
''' turn off screen updating '''
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
''' Find/Replace CA '''
sh1.Activate
fndArr = sh1.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
rplArr = sh1.Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
sh2.Activate
Columns("B").Select
For i = 0 To UBound(fndArr)
    Selection.EntireColumn.Select
    Selection.Replace What:=fndArr(i), Replacement:=rplArr(i), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
Next i
''' turn on screen updating '''
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

编辑：

代码中的以下更改允许它运行而不会引发错误，但随后它会查找/替换 A/B 列中的第一个值，例如休杰克曼休 J，但不是罗纳德·里根、罗纳德·R：

fndArr = Array(sh1.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row))
rplArr = Array(sh1.Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row))

Answer 1

当您将数组等同于一个范围时，即使只有一列，您也会创建一个基于 1 的 2D 数组，因此：

For i = 1 To UBound(fndArr)
    Selection.EntireColumn.Select
    Selection.Replace What:=fndArr(I,1), Replacement:=rplArr(I,1), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
Next I

编辑：您还需要摆脱选择内容。 也许以下（未测试）

'Delete these two lines
'sh2.Activate   
'Columns("B").Select
With sh2.Columns("B") 
For i = 0 To UBound(fndArr)
    .Replace What:=fndArr(I,1), Replacement:=rplArr(I,1), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
Next i