订单系统

alonzhang76 · 发表于 2022-12-31 10:04

在几位老师的帮助下正逐步完善了自己的出口订单系统，现还有2个问题期待老师帮忙，完成后相信做外贸行业的朋友都可稍微改一下便符合自己的订单统计需求：

1，”查询“ 工作表生成数据太慢，数据达到上百条后实在没法忍受，能否请老师帮忙用字典或数组修改模块”chaxun", 使其能快速完成数据填充；
2，如附件中的截图，解决自由选择保存PDF文件到某个文件夹。

3190496160 · 发表于 2022-12-31 12:19

Sub CX_查询系统查询按钮()
Application.ScreenUpdating = False
Dim br()
Dim dRow As Long
Dim kH As String
Dim mC As String
Range("D4:P" & Rows.Count).ClearContents
Range("D4:P" & Rows.Count).Borders.LineStyle = xlNone
If Trim(CStr(Range("B3").Value)) = "" Then
ks = CDate("1900-01-01")
Else
If IsDate(Trim(CStr(Range("B3").Value))) Then
      ks = CDate(Trim(CStr(Range("B3").Value)))
Else
      MsgBox "输入的起始日期不正确，请重新核对！", 48, "系统提示"
      Range("B3").Select
      Exit Sub
End If
End If

If Trim(CStr(Range("B4").Value)) = "" Then
js = CDate("2100-12-31")
Else
If IsDate(Trim(CStr(Range("B4").Value))) Then
      js = CDate(Trim(CStr(Range("B4").Value)))
Else
      MsgBox "输入的结束日期不正确，请重新核对！", 48, "系统提示"
      Range("B4").Select
      Exit Sub
End If
End If

If js < ks Then
MsgBox "输入的结束日期不能小于开始日期，请重新核对！", 48, "系统提示"
Range("B3").Select
Exit Sub
End If
kH = Trim(CStr(Range("B6").Value))
mC = UCase(Trim(CStr(Range("B8").Value)))
rr = Array(ks, 2, js, 2, kH, 1, mC, 5)
Dim mr()
ReDim mr(1 To 5, 1 To 3)
For i = 0 To UBound(rr) Step 2
If Trim(rr(i)) <> "" Then
      n = n + 1
      mr(n, 1) = rr(i)
      mr(n, 2) = rr(i + 1)
      If rr(i) = ks Then
         mr(n, 3) = "开始"
      ElseIf rr(i) = js Then
         mr(n, 3) = "结束"
      Else
         mr(n, 3) = ""
      End If
End If
Next i
If n = "" Then MsgBox "请至少输入一个查询条件！": End
With Sheet3
r = .Cells(Rows.Count, "A").End(xlUp).Row
If r < 2 Then MsgBox "订单登记表为空": End
ar = .Range("a1:m" & r)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
sl = 0
For s = 1 To n
      mC = mr(s, 1)
      lh = mr(s, 2)
      BJ = mr(s, 3)
      If BJ = "" Then
         If Trim(ar(i, lh)) = Trim(mC) Then
            sl = sl + 1
         End If
      ElseIf BJ <> "" Then
         If BJ = "开始" Then
            If ar(i, lh) >= mC Then
                  sl = sl + 1
            End If
         ElseIf BJ = "结束" Then
            If ar(i, lh) <= mC Then
                  sl = sl + 1
            End If
         End If
      End If
Next s
If sl = n Then
      m = m + 1
      hj = hj + ar(i, 9)
      je = je + ar(i, 10)
      For j = 1 To 13
         br(m, j) = ar(i, j)
      Next j
End If
Next i
If m = "" Then MsgBox "没有符合条件的数据！": End
[d4].Resize(m, UBound(br, 2)) = br
[d4].Resize(m, UBound(br, 2)).Borders.LineStyle = 1
[e2] = m
[l2] = hj
[m2] = je
Application.ScreenUpdating = True
MsgBox "OK!"
End Sub

3190496160 · 发表于 2022-12-31 12:23

Sub CX_查询系统查询按钮()
Application.ScreenUpdating = False
Dim br()
Dim dRow As Long
Dim kH As String
Dim mC As String
Range("D4:P" & Rows.Count).ClearContents
Range("D4:P" & Rows.Count).Borders.LineStyle = xlNone
If Trim(CStr(Range("B3").Value)) = "" Then
ks = CDate("1900-01-01")
Else
If IsDate(Trim(CStr(Range("B3").Value))) Then
      ks = CDate(Trim(CStr(Range("B3").Value)))
Else
      MsgBox "输入的起始日期不正确，请重新核对！", 48, "系统提示"
      Range("B3").Select
      Exit Sub
End If
End If

If Trim(CStr(Range("B4").Value)) = "" Then
js = CDate("2100-12-31")
Else
If IsDate(Trim(CStr(Range("B4").Value))) Then
      js = CDate(Trim(CStr(Range("B4").Value)))
Else
      MsgBox "输入的结束日期不正确，请重新核对！", 48, "系统提示"
      Range("B4").Select
      Exit Sub
End If
End If

If js < ks Then
MsgBox "输入的结束日期不能小于开始日期，请重新核对！", 48, "系统提示"
Range("B3").Select
Exit Sub
End If
kH = Trim(CStr(Range("B6").Value))
mC = UCase(Trim(CStr(Range("B8").Value)))
rr = Array(ks, 2, js, 2, kH, 1, mC, 5)
Dim mr()
ReDim mr(1 To 5, 1 To 3)
For i = 0 To UBound(rr) Step 2
If Trim(rr(i)) <> "" Then
      n = n + 1
      mr(n, 1) = rr(i)
      mr(n, 2) = rr(i + 1)
      If rr(i) = ks Then
         mr(n, 3) = "开始"
      ElseIf rr(i) = js Then
         mr(n, 3) = "结束"
      Else
         mr(n, 3) = ""
      End If
End If
Next i
If n = "" Then MsgBox "请至少输入一个查询条件！": End
With Sheet3
r = .Cells(Rows.Count, "A").End(xlUp).Row
If r < 2 Then MsgBox "订单登记表为空": End
ar = .Range("a1:m" & r)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
sl = 0
For s = 1 To n
      mC = mr(s, 1)
      lh = mr(s, 2)
      BJ = mr(s, 3)
      If BJ = "" Then
         If Trim(ar(i, lh)) = Trim(mC) Then
            sl = sl + 1
         End If
      ElseIf BJ <> "" Then
         If BJ = "开始" Then
            If ar(i, lh) >= mC Then
                  sl = sl + 1
            End If
         ElseIf BJ = "结束" Then
            If ar(i, lh) <= mC Then
                  sl = sl + 1
            End If
         End If
      End If
Next s
If sl = n Then
      m = m + 1
      hj = hj + ar(i, 9)
      je = je + ar(i, 10)
      For j = 1 To 13
         br(m, j) = ar(i, j)
      Next j
End If
Next i
If m = "" Then MsgBox "没有符合条件的数据！": End
[d4].Resize(m, UBound(br, 2)) = br
[d4].Resize(m, UBound(br, 2)).Borders.LineStyle = 1
[e2] = m
[l2] = hj
[m2] = je
Application.ScreenUpdating = True
MsgBox "OK!"
End Sub

3190496160 · 发表于 2022-12-31 12:23

订单系统20221223.rar (208.19 KB, 下载次数: 46)

清风客98 · 发表于 2022-12-31 13:59

1、把要比对的内容写入Dictionary，查找会快许多
2、把你获得的数据写入数组中，将来一次Range()=你的数组
这样弄下来，速度提升100倍，问题不大

洋务德雷 · 发表于 2022-12-31 17:19

使用sql+vba适合做这样的系统。逻辑简单，方便！

alonzhang76 · 发表于 2022-12-31 17:38

3190496160 发表于 2022-12-31 12:23

感谢再次帮忙，验算了一下：（1）按客户或是产品名称单个输入去查询，结果是对的（2）按起始和结束日期统计会少掉很多条目，所以结果是不对的（3）同时按起始，结束日，再添加个客户，双重条件搜索不到数据

alonzhang76 · 发表于 2022-12-31 17:45

洋务德雷发表于 2022-12-31 17:19
使用sql+vba适合做这样的系统。逻辑简单，方便！

谢谢你，为何我只是删掉客户名，还留其它条件点查询后会这样？见截图

洋务德雷 · 发表于 2022-12-31 22:14

alonzhang76 发表于 2022-12-31 17:45
谢谢你，为何我只是删掉客户名，还留其它条件点查询后会这样？见截图

这个和sql的那句代码有关系。我没有设置客户的模糊查询，只是设置了产品名称的模糊查询

alonzhang76 · 发表于 2022-12-31 22:16

3190496160 发表于 2022-12-31 12:23
Sub CX_查询系统查询按钮()
Application.ScreenUpdating = False
Dim br()

很奇怪，从2021/1/1到2021/12/31，结果漏掉了整个2~9月的数据，但1月和10~12月数据是完整的，为何？

		自动登录	找回密码
密码			免费注册

[求助] 订单系统

评分