如何按指定范围提取数据

阿力力

感谢所有回帖的高手，最后再次感谢准提部林 大师写的VBA，正是我想要的结果。

axiu5

你看一下，是不是你想要的效果

阿力力

axiu5 发表于 2022-11-24 15:47
你看一下，是不是你想要的效果

大师[bj:bo]列清空后没写入数据。帮忙改下

gwjkkkkk

1~2数值指什么意思，没理解，是对应一行中每个数值，还是其中一个？

阿力力

gwjkkkkk 发表于 2022-11-24 18:05
1~2数值指什么意思，没理解，是对应一行中每个数值，还是其中一个？

1个到2个。或2到4之类的。是个取值范围。这个是下拉菜单。能换，1~2，就是提取下面等于1或2的

axiu5

阿力力 发表于 2022-11-24 16:38
大师列清空后没写入数据。帮忙改下

"提取[BH]列数值在[BH1]范围之内的相对应[C3:H]列数据到[BJ3:BO]列"
你写的这句话，前半句和后半句都能看懂，就是连在一起看不懂了，你能再解释清楚点吗？

阿力力

axiu5 发表于 2022-11-25 10:26
"提取列数值在范围之内的相对应[C3:H]列数据到列"
你写的这句话，前半句和后半句都能看懂，就是连在一起 ...

比如设置2~4，查找[BH]列，等于2，3，4的那行前边[c:h]列对应的那六个数字，提取到[BJ3:BO]列。谢谢

阿力力

axiu5 发表于 2022-11-25 10:26
"提取列数值在范围之内的相对应[C3:H]列数据到列"
你写的这句话，前半句和后半句都能看懂，就是连在一起 ...

想用这个取范围，但我不会用If Val(arr(i, 60)) < Val(Left(arr(1, 60), 1)) Or Val(arr(i, 60)) > Val(Right(arr(1, 60), 1)) Then

axiu5

阿力力 发表于 2022-11-25 11:03
比如设置2~4，查找列，等于2，3，4的那行前边[c:h]列对应的那六个数字，提取到列。谢谢

C:\Users\zy\Desktop\微信图片_20221125141845.png
你在我上面发你的表格，代码里插入红框里的代码就可以了

axiu5

阿力力 发表于 2022-11-25 11:05
想用这个取范围，但我不会用If Val(arr(i, 60)) < Val(Left(arr(1, 60), 1)) Or Val(arr(i, 60)) > Val(R ...

1. Sub 提取()
   
2. Dim min%, max%
   
3. min = Split([bh1], "~")(0) '获取最小值
   
4. max = Split([bh1], "~")(1) '获取最大值
   
5. Dim rng As Range, c%, arr
   
6. For Each rng In Range("bh3:bh" & Range("bh65536").End(3).Row)
   
7. If rng >= min And rng <= max Then '判断bh列单元格数值是否在最大 最小值内
   
8. c = c + 1 '计数
   
9. arr = Range("c" & rng.Row).Resize(1, 6)
   
10. rng.Offset(0, 2).Resize(1, 6) = arr '左侧单元格数据到右侧单元格
    
11. Else '如果不在范围内
    
12. rng.Offset(0, 2).Resize(1, 6) = "" '右侧单元格为空值
    
13. End If
    
14. Next
    
15. [bj1] = "提取结果:" & c & "注"
    
16. Dim i%
    
17. For i = 3 To Range("bh65536").End(3).Row
    
18. If Range("bh" & i) <> "" Then
    
19. Range("bi" & i) = Application.WorksheetFunction.CountA(Range("bh3:bh" & i))
    
20. End If
    
21. Next
    
22. End Sub
    
23. 
    
24. Private Sub Worksheet_Change(ByVal Target As Range)
    
25. Dim rng As Range
    
26. Set rng = Intersect(Target, [bh:bh])
    
27. If rng Is Nothing Then
    
28. Exit Sub
    
29. Else
    
30. '[bj1] = ""
    
31. Call 提取
    
32. End If
    
33. End Sub

复制代码