下标越界

ddz79101

老师！有表需提编码，但代码运行下标越界。请老师指点。谢谢！

ykcbf1100

原代码改一下。。。

ykcbf1100

参与一下。。。

sxbjzjf110

你是扩展r行1列，拆分又是第3列。所以错误。

ynzsvt

改过的地方都用yzv注释了一下，自己仔细体会。

quqiyuan

引用位置resize不正确，修改了一下，仅供参考，，，

quqiyuan

代码如下。。。
Sub 提取()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheets("sheet1").[a1].CurrentRegion
    For i = 2 To UBound(arr)
        s = Trim(arr(i, 2))
        d(s) = arr(i, 3)
    Next
    With Sheets("sheet2")
         r = .Cells(Rows.Count, 3).End(3).Row
         arr = .Range(.[a4], .Cells(r, 4)) 'Resize(r, 15)
         For i = 2 To UBound(arr)
             s = Split(Trim(arr(i, 3)), " ")(0)
             arr(i, 4) = d(s)
         Next
         .Range(.[a4], .Cells(r, 4)) = arr 'Resize(r, 1)
    End With
    MsgBox "OK!"
End Sub

ddz79101

ykcbf1100 发表于 2024-10-19 07:54
原代码改一下。。。

谢谢老师！运行成功！

ddz79101

ynzsvt 发表于 2024-10-19 07:57
改过的地方都用yzv注释了一下，自己仔细体会。

谢谢老师！运行成功！

ddz79101

quqiyuan 发表于 2024-10-19 08:39
代码如下。。。
Sub 提取()
    Set d = CreateObject("Scripting.Dictionary")

谢谢老师！运行成功！