蓝桥版主的代码 修改了一点就计算错误，要如何修改才能得到正确的

1234vba

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

2018-9-13 11:52 上传

点击文件名下载附件

附件下载：
Book0414.rar (10.78 KB, 下载次数: 2)

2018-9-12 22:20 上传

点击文件名下载附件

原代码来自蓝桥版主的。10楼
http://club.excelhome.net/thread-1112178-1-1.html

原例子，A列没有数据，
所以能正确得到结果。

我在A列上加上数据后，代码就无法得到正确结果

代码的意思是：抽取 C1值30 在B列中的后2个单元格的数字（d=2），不够2个单元格的数字，一样抽取，直到没有



要如何修改代码，当A列也有数据的时候，才能得到B列的正确的结果呢。

问题是不是出在这句代码里呢？
Arr = [b2].CurrentRegion

请各位老师帮忙修正
······················································

更新说明：
代码要求与说明：
附件有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列的数据
W列 用于存放 提取到B列的数据
X列 用于存放 提取到C列的数据

lsc900707

你知道了问题所在，那就把相应的地方修改呀。

不知道为什么

每一次纠错的过程，就是默默的进步过程。加油！

1234vba

lsc900707 发表于 2018-9-12 23:03
你知道了问题所在，那就把相应的地方修改呀。

老师好。。。

  我是自己想  或许不用 CurrentRegion 获得 a列 或 b列的内容了代码就能正确获取数据了

1234vba

lsc900707 发表于 2018-9-12 23:03
你知道了问题所在，那就把相应的地方修改呀。

我尝试改成 Arr = Sheet1.Range("b:b")

或 Arr = Sheet1.Range("a:a")

无法得到正确的值

1234vba

Sub 按钮1_单击()
Dim Arr, i&, sz, gs, j&, aa
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
sz = [m1].Value: gs = [u1].Value
'Arr = [a1].CurrentRegion
Arr = Sheet1.Range("a:a")‘改成这样直接获得A列或其他列数据
For i = 1 To UBound(Arr) - gs
    If Arr(i, 1) = sz Then d(Arr(i, 1)) = d(Arr(i, 1)) & i & ","
Next
k = d.keys: t = d.items: n = 1
For i = 0 To UBound(k)
    t(i) = Left(t(i), Len(t(i)) - 1)
    If InStr(t(i), ",") Then
        aa = Split(t(i), ",")
        For j = 0 To UBound(aa)
            Cells(n, 22).Resize(gs, 1) = Cells(aa(j) + 1, 2).Resize(gs, 1).Value
            n = n + gs
        Next
    Else
        [v1].Resize(gs, 1) = Cells(t(i) + 2, 2).Resize(gs, 1).Value
    End If
Next
End Sub

一样得不到正确的数据。。。

如图。。。

正确结果应该为
1
10
8
4

又比如 提取 10的后两个数值


正确结果应该为：
2
7
1
8

代码搞不懂为什么会提取错误了

1234vba

提取10，代码得不到正确结果

蓝桥玄霜

请见代码。

1. Sub lqxs()
   
2. Dim Arr, i&, sz, gs, n&
   
3. Sheet1.Activate
   
4. [g:g].ClearContents
   
5. sz = [c2].Value: gs = [d2].Value
   
6. Myr = Cells(Rows.Count, 2).End(xlUp).Row
   
7. Arr = Range("b2:b" & Myr)
   
8. For i = 1 To UBound(Arr) - gs
   
9.     If InStr(Arr(i, 1), sz) Then
   
10.         n = n + 1
    
11.         Cells(n, 7).Resize(gs, 1) = Cells(i + 2, 2).Resize(gs, 1).Value
    
12.         n = n + gs - 1
    
13.     End If
    
14. Next
    
15. End Sub
    

复制代码

1234vba

蓝桥玄霜 发表于 2018-9-13 08:35
请见代码。

谢谢  蓝桥版主的回复。。。好速度。

1234vba

蓝桥玄霜 发表于 2018-9-13 08:35
请见代码。

老师好。。代码运行错误。

这代码应该是之前例子的 第二道题目的解法吧

第二道题 的解法。。结果也有点错误。。

比如 c1=04 时。结果就是错误的