跟随提取的问题。请教各位老师帮忙

1234vba

附件下载“ bug.rar (11.46 KB, 下载次数: 2)

2018-9-13 11:53 上传

点击文件名下载附件

表格里 有一份代码，
是14年蓝桥老师的代码。（搜索到的）
我套入表格的例子里无法得到正确结果

请各位老师帮忙

代码要求与说明：

附件有A-C列3行数据

K1-M1各自对应A列，B列，C列数据，
U1单元格的值N，是跟随提取N个单元格
U1=1，意思是跟随提取后1个单元格的值
U1=2，意思是跟随提取后2个单元格的值


跟随提取的意思是：

例子：K1=1，代码判断A列的单元格数据，
若单元格的值存在1，
那么就取该单元格后的两个单元格的值8,10
存放到V列


取到的值依次写入V-X列
v列 用于存放 提取到A列的数据

zjdh

TEST.rar (11.3 KB, 下载次数: 4)

2018-9-13 13:34 上传

点击文件名下载附件

1234vba

zjdh 发表于 2018-9-13 13:34

zjdh老师好。。
我修改k1-m1的值后，执行代码  提示  错误


哪个变量 越界了？？

zjdh

你第二个6正好在最后一行所致。

TEST2.rar (11.52 KB, 下载次数: 1)

2018-9-13 22:50 上传

点击文件名下载附件

1234vba

zjdh 发表于 2018-9-13 21:36
你第二个6正好在最后一行所致。

zjdh老师晚上好。。

现在又不知道是哪里越界了。。
例子在 表2里。

TEST2 越界.rar (14.39 KB, 下载次数: 2)

2018-9-13 22:16 上传

点击文件名下载附件


要提取的值 全部在后面，，貌似就越界

1234vba

是不是 我的例子 太 离谱了

zjdh

TEST3.rar (11.46 KB, 下载次数: 2)

2018-9-13 22:47 上传

点击文件名下载附件

天下任我行

Public Sub 提取不同列的数据()
Dim arr, arrs
Dim x, y, k, n As Integer
n = Range("u1")
Dim arrs1(1 To 10000, 1 To 3)
arr = Range("a1:c" & Range("c65536").End(xlUp).Row)
arrs = Range("k1:m3")
For y = 1 To 3
For x = 1 To UBound(arr)
If arr(x, y) = arrs(1, y) Then
For k = 1 To n
arrs1(x + k, y) = arr(x + k, y)
Next k
End If
Next x
Next y
Range("ab1").Resize(UBound(arrs1), 3) = arrs1
Range("ab1").Resize(UBound(arrs1), 3).SpecialCells(xlCellTypeBlanks).Delete
End Sub