恳请大神们帮忙解决这个提取相关数据的难题

qiongmei6

我想求得一个代码，当他执行的时候，他根据y3：ao124列中，找出y列中没有“聘用工”的aa3：ao124的内容填入au3：bi列，目前的au3：bi就是我希望代码执行后得到的结果，非常谢谢各位大神的帮忙。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.29
   
2.     r = Cells(Rows.Count, "y").End(3).Row
   
3.     arr = Range("y3:ao" & r)
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 2 To UBound(arr)
   
6.         If arr(i, 1) <> "聘用工" Then
   
7.             m = m + 1
   
8.             For j = 3 To UBound(arr, 2)
   
9.                 brr(m, j - 2) = arr(i, j)
   
10.             Next
    
11.         End If
    
12.     Next
    
13.     [au3:bi10000] = ""
    
14.     [au3].Resize(m, UBound(brr, 2)) = brr
    
15.     MsgBox "OK！"
    
16. End Sub
    

复制代码

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, k%, arr, brr
   
3.     arr = Sheet21.Range("Y3:AO124").Value
   
4.     ReDim brr(1 To 1000, 1 To UBound(arr, 2))
   
5.     For i = LBound(arr) To UBound(arr)
   
6.         If arr(i, 1) <> "聘用工" Then
   
7.             k = k + 1
   
8.             For j = 3 To UBound(arr, 2)
   
9.                 brr(k, j) = arr(i, j)
   
10.             Next
    
11.         End If
    
12.     Next
    
13.     Sheet21.Range("AU3").Resize(k, UBound(arr, 2)) = brr
    
14. End Sub

复制代码

lushang2018

试一试，试一试