表格一过3300行就报错

月落天涯

向各位大神求助，表格里有月报，日报及出入库查询三个功能，对应三组代码，可是表格行数一过3300行就报错，崩溃啊！有劳各位大神看看什么问题，给改一改。有鲜花。

taller

月落天涯

taller 发表于 2024-11-16 07:59

非常感谢大神，日报及月报问题圆满解决，出入库查询的问题该如何处理，能否再劳烦大神看看。

taller

月落天涯 发表于 2024-11-16 09:16
非常感谢大神，日报及月报问题圆满解决，出入库查询的问题该如何处理，能否再劳烦大神看看。

出入库查询的有什么问题

月落天涯

taller 发表于 2024-11-16 09:20
出入库查询的有什么问题

和日报月报一样，提示类型不匹配，一过3300行就报错。

taller

问题根源是相同的（例如3314行），arr(i, 11)不是日期，那么Month(arr(i, 11))导致运行时错误

没有看懂sss变量组合字符串的用途

月落天涯

taller 发表于 2024-11-16 09:25
问题根源是相同的（例如3314行），arr(i, 11)不是日期，那么Month(arr(i, 11))导致运行时错误

没有看懂s ...

该如何处理，还请大神出手。

taller

试试这个

1. Public Sub 出入库查询()
   
2.     Dim jieguo(1 To 1000000, 1 To 15)
   
3.     arr = Sheets("出入库明细").Range("a3").CurrentRegion
   
4.     If Sheets("出入库查询").Range("Q1") = "" Then a = "*" Else a = Sheets("出入库查询").Range("Q1")
   
5.     If Sheets("出入库查询").Range("Q2") = "" Then b = "*" Else b = Sheets("出入库查询").Range("Q2")
   
6.     If Sheets("出入库查询").Range("Q3") = "" Then c = "*" Else c = Sheets("出入库查询").Range("Q3")
   
7.     If Sheets("出入库查询").Range("T1") = "" Then d = "*" Else d = Sheets("出入库查询").Range("T1")
   
8.     If Sheets("出入库查询").Range("T2") = "" Then e = "*" Else e = Sheets("出入库查询").Range("T2")
   
9.     If Sheets("出入库查询").Range("T3") = "" Then f = "*" Else f = Sheets("出入库查询").Range("T3")
   
10.     If Sheets("出入库查询").Range("W1") = "" Then g = "*" Else g = Sheets("出入库查询").Range("W1")
    
11.     If Sheets("出入库查询").Range("W2") = "" Then h = "*" Else h = Sheets("出入库查询").Range("W2")
    
12.     If Sheets("出入库查询").Range("W3") = "" Then i = "*" Else i = Sheets("出入库查询").Range("W3")
    
13.     If Sheets("出入库查询").Range("Z1") = "" Then j = "*" Else j = Sheets("出入库查询").Range("Z1")
    
14.     If Sheets("出入库查询").Range("Z2") = "" Then k = "*" Else k = Sheets("出入库查询").Range("Z2")
    
15.     If Sheets("出入库查询").Range("Z3") = "" Then l = "*" Else l = Sheets("出入库查询").Range("Z3")
    
16.     If Sheets("出入库查询").Range("AC1") = "" Then P = "*" Else P = Sheets("出入库查询").Range("AC1")
    
17.     If Sheets("出入库查询").Range("AC2") = "" Then r = "*" Else r = Sheets("出入库查询").Range("AC2")
    
18.     If Sheets("出入库查询").Range("AC3") = "" Then v = "*" Else v = Sheets("出入库查询").Range("AC3")
    
19.    
    
20.    
    
21.    
    
22.     s = a & "@" & b & "@" & c & "@" & d & "@" & e & "@" & f & "@" & g & "@" & h & "@" & i & "@" & j & "@" & k & "@" & l & "@" & P & "@" & r & "@" & v
    
23.     Dim sDate, sd
    
24.     For i = 2 To UBound(arr)
    
25.         sss = arr(i, 6) & "@" & arr(i, 4) & "@" & arr(i, 11) & "@DATE11@" & arr(i, 13) & "@DATE13@" & arr(i, 2) & "@" & arr(i, 9) & "@" & arr(i, 2) & "@" & arr(i, 7) & "@" & arr(i, 5)
    
26.         If IsDate(arr(i, 11)) Then
    
27.             sd = "@" & Month(arr(i, 11)) & "@" & Int(1 + (Month(arr(i, 11)) - 1) / 3) & "@" & Year(arr(i, 11)) & "@"
    
28.         Else
    
29.             sd = "@*@*@*@"
    
30.         End If
    
31.         sss = Replace(sss, "@DATE11@", sd)
    
32.         If IsDate(arr(i, 13)) Then
    
33.             sd = "@" & Month(arr(i, 13)) & "@" & Int(1 + (Month(arr(i, 13)) - 1) / 3) & "@" & Year(arr(i, 13)) & "@"
    
34.         Else
    
35.             sd = "@*@*@*@"
    
36.         End If
    
37.         sss = Replace(sss, "@DATE13@", sd)
    
38.         If sss Like s Then
    
39.             n = n + 1
    
40.             For m = 1 To 15
    
41.                 jieguo(n, m) = arr(i, m)
    
42.             Next
    
43.         End If
    
44.     Next
    
45.     Sheets("出入库查询").Rows("4:100000").ClearContents
    
46.     If n <> 0 Then
    
47.         Sheets("出入库查询").Range("a4").Resize(n, 15) = jieguo
    
48.     Else
    
49.         MsgBox "未检索到数据，请核实"
    
50.     End If
    
51. End Sub

复制代码

月落天涯

taller 发表于 2024-11-16 10:58
试试这个

太棒了，多谢大神。