如何根据条件提取汇总表中的数据

ykcbf1100

Benfyhu 发表于 2024-4-30 17:27

DateValue函数适用于所有office版本，你这里出错不应该啊，我这里没有任何问题，能正常提取数据。不过，WPS能不能运行我不知道。

Benfyhu

ykcbf1100 发表于 2024-4-30 19:13
DateValue函数适用于所有office版本，你这里出错不应该啊，我这里没有任何问题，能正常提取数据。不过，W ...

我的是EXCEL2016

Benfyhu

limonet 发表于 2024-4-30 18:05
哪里提错？

Benfyhu

limonet 发表于 2024-4-30 18:05
哪里提错？

这一段提错

limonet

是不是源文件不一样？

Benfyhu

limonet 发表于 2024-5-3 19:41
是不是源文件不一样？

应该不是，我是直接下了您发上来的附件打开。也是报一样的错误。所以就怪了。我一个查字符代码好像都没问题

Benfyhu

ykcbf1100 发表于 2024-4-30 19:13
DateValue函数适用于所有office版本，你这里出错不应该啊，我这里没有任何问题，能正常提取数据。不过，W ...

你好。我去掉DateValue就可以提取成功了。另外有一个问题还请教一下。如果是没数据时，后面那部份如何写一段代码 。谢谢

ykcbf1100

Benfyhu 发表于 2024-5-6 18:50
你好。我去掉DateValue就可以提取成功了。另外有一个问题还请教一下。如果是没数据时，后面那部份如何写 ...

我问过AI，它说DateValue函数适用于所有的office版本。

ykcbf1100

Benfyhu 发表于 2024-5-6 18:50
你好。我去掉DateValue就可以提取成功了。另外有一个问题还请教一下。如果是没数据时，后面那部份如何写 ...

我不用DateValue函数了，你再试一下。

ykcbf1100

代码更新一下。。。

1. Sub ykcbf()   '//2024.5.6
   
2.     Dim arr, brr
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheet3.Range("a1").CurrentRegion
   
5.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
   
6.     b = [{1,2,3,5,6,7,8,9,10}]
   
7.     With Sheets("产能查询")
   
8.         .[a4:i10000] = ""
   
9.         rq1 = CLng(.[g2])
   
10.         rq2 = CLng(.[i2])
    
11.         xm = .[b2]
    
12.         For i = 2 To UBound(arr)
    
13.             rq = CLng(arr(i, 5))
    
14.             If rq >= rq1 And rq <= rq2 Then
    
15.                 If arr(i, 4) = xm Then
    
16.                     m = m + 1
    
17.                     brr(m, 1) = m
    
18.                     For j = 2 To UBound(b)
    
19.                         brr(m, j) = arr(i, b(j))
    
20.                     Next
    
21.                 End If
    
22.             End If
    
23.         Next
    
24.         .Columns(5).NumberFormatLocal = "0"
    
25.         If m > 0 Then
    
26.             .[a4].Resize(m, UBound(arr, 2) - 1) = brr
    
27.         Else
    
28.             MsgBox "无相应数据！"
    
29.             Exit Sub
    
30.         End If
    
31.     End With
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码