提取达标记录，并以此为标准，提取同类记录，谢谢 ykcbf1100和chxw68、Qs18老师！

lhj323323

老师：

上传的附件有写好的语句
但仅是半成品（即只完成了第一步，且还不正确）

求助.rar (17.67 KB, 下载次数: 7)

2024-9-10 13:24 上传

点击文件名下载附件

说明如下：


老师，如有空，请帮忙看看，先谢谢了

语句如下

杨建营

请楼主参考。

杨建营

第一步和第二步都有了

Qs18

1. Sub qs()
   
2. Dim arr, i, a
   
3. a = [{"专用机械","医疗保健","化学制药"}]
   
4. arr = Sheet1.Range("a1").CurrentRegion.Value
   
5. ReDim brr(1 To UBound(arr), 1 To 4)
   
6. For i = 1 To UBound(a)
   
7.     For y = 2 To UBound(arr)
   
8.         s = arr(y, 3)
   
9.         If a(i) = s Then
   
10.             m = m + 1
    
11.             For x = 1 To 4
    
12.                 brr(m, x) = arr(y, x)
    
13.             Next
    
14.         End If
    
15.     Next
    
16. Next
    
17. Sheet1.Range("u19").Resize(m, 4) = brr '改成需要的位置
    
18. End Sub
    

复制代码

Qs18

试试。。。。。。。。。

Qs18

试试。。。。。。。。

lhj323323

杨建营 发表于 2024-9-10 14:06
请楼主参考。

谢谢老师！

lhj323323

Qs18 发表于 2024-9-10 14:30

谢谢老师！

lhj323323

Qs18 发表于 2024-9-10 14:33
试试。。。。。。。。

老师：
下图里
两组蓝框，都是基于红框而生成的

按纽在运行【前】，只有红框的数据，并不知道后续是不是这三个
专用机械","医疗保健","化学制药

ykcbf1100

原代码小改一下。
原代码把B列为--也提取出来，是因为B列有文本，用ar(i,2)>4.5判断方式不对，
应该如此：If Val(ar(i, 4)) = 0 And Val(ar(i, 2)) > 4.5 Then