用excel VBA按条件筛选后将数据汇总在工作表里其它信息下方

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.14
   
2.     With Sheets("输入")
   
3.         arr = .[a1:ad64].Value
   
4.         rq = .[g2].Value
   
5.         bc = .[w2].Value
   
6.     End With
   
7.     ReDim brr(1 To 1000, 1 To 7)
   
8.     For i = 5 To UBound(arr)
   
9.         If arr(i, 3) <> Empty Then
   
10.             For j = 7 To UBound(arr, 2) Step 3
    
11.                 If arr(i, j) <> Empty Then
    
12.                     m = m + 1
    
13.                     brr(m, 1) = rq
    
14.                     brr(m, 2) = bc
    
15.                     brr(m, 3) = arr(i, 3)
    
16.                     brr(m, 4) = arr(3, j)
    
17.                     brr(m, 5) = arr(i, j)
    
18.                     brr(m, 6) = arr(i, j + 1)
    
19.                     brr(m, 7) = arr(i, j + 2)
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("数据汇总")
    
25.         r = .Cells(Rows.Count, 2).End(3).Row
    
26.         .Cells(r + 1, 2).Resize(m, 7) = brr
    
27.     End With
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码

huo456

longwin 发表于 2024-5-14 15:46

老师 设备1/ 设备2   怎么上去的 帮忙再发一下 感谢感谢！！！

huo456

ykcbf1100 发表于 2024-5-14 15:51
附件供参考。。。

感谢  感谢

huo456

longwin 发表于 2024-5-14 15:42
请测试......

感谢  感谢

longwin

huo456 发表于 2024-5-14 15:52
老师 设备1/ 设备2   怎么上去的 帮忙再发一下 感谢感谢！！！

更新了，可能没成功，重新上传。

huo456

longwin 发表于 2024-5-14 16:05
更新了，可能没成功，重新上传。

longwin

huo456

完美