请老师帮忙修改查询出现警告窗口的VBA代码，感激不尽！！！

爱诗利

第一：
操作方式：点击清除
输入出货单编号：22102232.点击查询在：客户名、日期、产品名称、数量（黄色位置）显示（出货数据库）里的数据在送货单表格里
修改正确的数据后。点击：修改保存。及修改打印时也要保存。保存修改正确的数据插入到出货数据库。旧该单号数据删除
求：查询、修改保存、修改打印，VBA代码
（修改打印，代码也有一次保存。好多打印后忘记保存后退出，所以在打印时再一次保存。）
修改保存，有时单独保存后就不要打印。

第二：
查询里的：进货日期查询、销售日期查询。输入日期范围内查询时数据库有日期内就没有也现警告出错窗口，如果超出数据库里没有范围内的日期就会出现警告出错窗口
求：VBA代码。如果没有查询的日期范围内的数据库就现在警告窗口提示：查询的日期范围内没有数据，请重新输入正确日期。这样的提示



第三：
查询显示数据很慢，一行行显示。是否可以修改更快的VBA显示代码。


特别感谢：taller，我是你猴哥、peteroo7、624134745。这几位老师指导和帮助,老师的专业的讲解让我受益匪浅、实在让愚钝的我感到惭愧与敬仰。谢谢

02761752696

像是看论文......
路过帮顶

smsn

点下调试，再截个停下的位置

爱诗利

smsn 发表于 2022-11-18 07:58
点下调试，再截个停下的位置

Sub 销售日期段查询()
Sheets("查询").Range("A2:G2,A4:L8800") = "" '判断要删除或者清除的区域
    ar = Sheet20.Range("A2").CurrentRegion
    ks = Sheet4.[k1]: js = Sheet4.[k2]
    For i = 2 To UBound(ar)
        k = CDate(Replace(ar(i, 2), ".", "-"))
        If k >= ks And k <= js Then
            m = m + 1
            For j = 1 To UBound(ar, 2)
                ar(m, j) = ar(i, j)
            Next
        End If
    Next
    Sheet4.UsedRange.Offset(3).ClearContents
    Sheet4.Range("A4").Resize(m, UBound(ar, 2)) = ar
End Sub

爱诗利

Sub 出货单修改查询() '查询
    If [N2] < " " Then MsgBox "请填单号": Exit Sub
    Application.EnableEvents = False
      With Sheets("出货数据库")
        Set rg = .[A:A].Find([N2], , , 1)
        If rg Is Nothing Then MsgBox "没找到 " & [j2]: Application.EnableEvents = True: Exit Sub
        r = rg.Row
        [c3] = .Cells(r, 3) '客户名称
        [N4] = .Cells(r, 2) '日期
        
        For h = 7 To 15
            If .Cells(r, 1) = [N2] Then
                Range("B" & h) = .Cells(r, 5)
                Range("L" & h) = .Cells(r, 10)
                r = r + 1
            End If
        Next h
    End With
    Application.EnableEvents = True
    CommandButton3.Enabled = False
End Sub

爱诗利

Sub 出货单修改保存() '修改保存
    With Sheets("出货数据库")
        Set rg = .[A:A].Find([N2], , , 1)  '编号
        If Not rg Is Nothing Then
           r = rg.Row
        End If
        For h = 7 To 15  '输入范围
             If Range("b" & h) > " " Then
                .Cells(r, 5) = Range("b" & h) '产品名称
                .Cells(r, 7) = Range("g" & h) '
                ar = Range("b" & h & ":h" & h)
                .Range("n" & r & ":l" & r) = ar
                r = r + 1
            End If
        Next h
    End With
End Sub

爱诗利

smsn 发表于 2022-11-18 07:58
点下调试，再截个停下的位置

早上好
老师请你有空帮帮忙，修改错误的问题
谢谢

smsn

爱诗利 发表于 2022-11-23 09:30
早上好
老师请你有空帮帮忙，修改错误的问题
谢谢

最直接的原因是m是空值。
m是空值又是因为
开始日期 设置为        2018/2/15
结束日期 设置为        2019/2/15

k 值是 进货数据库 内的日期。
k值都是在这个范围外的，导致m一直空值，自然就会出错。
你把 开始日期和结束日期改下就好了。

smsn

爱诗利 发表于 2022-11-18 08:23
Sub 销售日期段查询()
Sheets("查询").Range("A2:G2,A4:L8800") = "" '判断要删除或者清除的区域
  ...

1. Sub 进货日期段查询()
   
2.     Sheets("查询").Range("A2:G2,A4:L8800") = "" '判断要删除或者清除的区域
   
3.     ar = Sheet7.Range("A2").CurrentRegion
   
4.     ks = Sheet4.[k1]: js = Sheet4.[k2]
   
5.     For i = 2 To UBound(ar)
   
6.         k = CDate(Replace(ar(i, 2), ".", "-"))
   
7.         If k >= ks And k <= js Then
   
8.             m = m + 1
   
9.             For j = 1 To UBound(ar, 2)
   
10.                 ar(m, j) = ar(i, j)
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     If m = Empty Then
    
15.         MsgBox "无符合日期的项目，程序结束"
    
16.         Exit Sub
    
17.     End If
    
18.     Sheet4.UsedRange.Offset(3).ClearContents
    
19.     Sheet4.Range("A4").Resize(m, UBound(ar, 2)) = ar
    
20. End Sub

复制代码

最好找下程序设计的人修改。