[已解决]下标越界的问题

gylilan

说明在附件中。谢谢各位老师。

最佳答案

月排行榜 / 总排行榜

QLZ0602

2014-11-21 12:58

Sub 查找断号()

Dim arr1, arr2, i As Integer, Rng As Range, onlys As New Collection, x As Integer, y As Integer 'str
   
   
    r = [a65536].End(3).Row
    y = Cells(r, 1) - [a1] + 1
   
   
   
   [a1].Resize(r, 1).RemoveDuplicates Columns:=1, Header:=xlNo
   arr1 = [a1].Resize(r, 1).Value
   
  
   ReDim arr2(1 To y)
   
    For x = 1 To y
    arr2(x) = Format(x + [a1] - 1, "000000000")
   
    Next x

For i = 1 To UBound(arr1)
   

    arr2 = Filter(arr2, arr1(i, 1), False, 1)

Next i
For i = 0 To UBound(arr2)
    Cells(i + 2, 3) = arr2(i)
Next i
End Sub

跳转到最佳答案楼层

这儿有肥猫

这个根本不需要用到VBA，很简单的几步操作就可以做到~

gylilan

这儿有肥猫 发表于 2014-11-21 12:34
这个根本不需要用到VBA，很简单的几步操作就可以做到~

我只取了其中的一小部份来作本，实际工作中数据量比较大，而且操作频繁，我也试过用vlook函数加筛选的方法来解决，但还是觉得太繁琐，所以选择用VBA，一次到位。

qh8600

gylilan 发表于 2014-11-21 12:44
我只取了其中的一小部份来作本，实际工作中数据量比较大，而且操作频繁，我也试过用vlook函数加筛选的方法 ...

我只想告诉你，单元格是全二维，arr1是二维数组，arr2也是二维数组，所以循环变量是  i=1 to ubound(arr1)
arr2(i,1），不是arr2

QLZ0602

Sub 查找断号()

Dim arr1, arr2, i As Integer, Rng As Range, onlys As New Collection, x As Integer, y As Integer 'str
   
   
    r = [a65536].End(3).Row
    y = Cells(r, 1) - [a1] + 1
   
   
   
   [a1].Resize(r, 1).RemoveDuplicates Columns:=1, Header:=xlNo
   arr1 = [a1].Resize(r, 1).Value
   
  
   ReDim arr2(1 To y)
   
    For x = 1 To y
    arr2(x) = Format(x + [a1] - 1, "000000000")
   
    Next x

For i = 1 To UBound(arr1)
   

    arr2 = Filter(arr2, arr1(i, 1), False, 1)

Next i
For i = 0 To UBound(arr2)
    Cells(i + 2, 3) = arr2(i)
Next i
End Sub

gylilan

QLZ0602 发表于 2014-11-21 12:58
Sub 查找断号()

Dim arr1, arr2, i As Integer, Rng As Range, onlys As New Collection, x As Integer, ...

代码测试过了，挺好用的，不过一有点不足，就是找出的断号是数值型的，而A列的的数据都是文本型的，希望代码中直接将找出的断号格式设置成与A列的一致，这样就不用每次找完后都要再手动设置了。这个可以解决吗？另外能否请老师告诉我之前的代码错误的原因吗。我初学VBA，希望多向老师学习一下。谢谢

gylilan

QLZ0602 发表于 2014-11-21 12:58
Sub 查找断号()

Dim arr1, arr2, i As Integer, Rng As Range, onlys As New Collection, x As Integer, ...

我尝试用这句代码，但出来的结果还是数值型。不知道老师有什么简单易会的代码可以解决此问题。谢谢
Cells(r + i + 1, 1) = Format(arr2(i), "000000000")

QLZ0602

Cells(r + i + 1, 1) = "'" & Format(arr2(i), "000000000")

QLZ0602

原因可qq联系 695982239

gylilan

QLZ0602 发表于 2014-11-21 16:09
Cells(r + i + 1, 1) = "'" & Format(arr2(i), "000000000")

文本格式的问题解决了，多谢。