在通过Array循环到列中的查找/替换时,“下标超出范围”错误

时间:2016-06-06 14:29:16

标签: arrays excel vba

我在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列中的第一个值,例如: Hugh Jackman Hugh J,但不是Ronald Reagan,Ronald 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))

1 个答案:

答案 0 :(得分:2)

当您将数组等同于某个范围时,即使使用单个列,也可以创建基于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