运费计算

42921783

zhaogang1960 发表于 2014-3-5 20:48
请测试附件

目的市唯一作用（有明确指向），在于惠州发惠州用顺丰，如1850行，订单重量6公斤，运费=首重收费8+（重量6-首重1）*续重1KG1+上门服务费0=8+5*1+0=13。

zhaogang1960

42921783 发表于 2014-3-5 21:06
目的市唯一作用（有明确指向），在于惠州发惠州用顺丰，如1850行，订单重量6公斤，运费=首重收费8+（重量 ...

先请测试 KCFONG版主的代码，容我想想

zhaogang1960

42921783 发表于 2014-3-5 21:06
目的市唯一作用（有明确指向），在于惠州发惠州用顺丰，如1850行，订单重量6公斤，运费=首重收费8+（重量 ...

1. Sub Macro1()
   
2.     Dim cnn, SQL$, a, arr, brr(), i&, j&, s$, d As Object, ds As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set ds = CreateObject("scripting.dictionary")
   
5.     arr = [a1].CurrentRegion
   
6.     ReDim brr(2 To UBound(arr), 1 To 1)
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 8) & arr(i, 7) & arr(i, 5) & arr(i, 1)
   
9.         d(s) = d(s) & "," & i
   
10.         s = arr(i, 8) & arr(i, 7) & arr(i, 5) & arr(i, 1) & arr(i, 6)
    
11.         ds(s) = ds(s) & "," & i
    
12.     Next
    
13.     Set cnn = CreateObject("adodb.connection")
    
14.     cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ActiveWorkbook.FullName
    
15.     SQL = "select a.订单重量,a.订单运费,a.订单编码,a.重量,a.目的省,a.目的市,a.快递公司,a.库房编码,b.首重收费,b.重量,b.首重,b.首重收费,b.续重1KG,b.上门服务费,b.目的市 from [订单$" _
    
16.         & [a1].CurrentRegion.Address(0, 0) & "] a left join [运费标准$] b on a.库房编码=b.库房编码 and a.快递公司=b.快递公司  and  a.目的省=b.目的省"
    
17.     arr = cnn.Execute(SQL).GetRows
    
18.     For i = 0 To UBound(arr, 2)
    
19.         If Not IsNull(arr(0, i)) Then
    
20.             If Application.Evaluate(arr(0, i) & arr(9, i)) Then
    
21.                 If arr(14, i) <> "省内所有" Then
    
22.                     a = Split(ds(arr(7, i) & arr(6, i) & arr(4, i) & arr(0, i) & arr(14, i)), ",")
    
23.                     For j = 1 To UBound(a)
    
24.                         brr(Val(a(j)), 1) = arr(11, i) + (arr(0, i) - arr(10, i)) * arr(12, i) + arr(13, i)
    
25.                     Next
    
26.                 Else
    
27.                     a = Split(d(arr(7, i) & arr(6, i) & arr(4, i) & arr(0, i)), ",")
    
28.                     For j = 1 To UBound(a)
    
29.                         If brr(Val(a(j)), 1) = "" Then brr(Val(a(j)), 1) = arr(11, i) + (arr(0, i) - arr(10, i)) * arr(12, i) + arr(13, i)
    
30.                     Next
    
31.                 End If
    
32.             End If
    
33.         End If
    
34.     Next
    
35.     [b2].Resize(UBound(brr) - 1) = brr
    
36.     cnn.Close
    
37.     Set cnn = Nothing
    
38. End Sub
    

复制代码

zhaogang1960

请测试附件
运费计算3.rar (120.43 KB, 下载次数: 42)

2014-3-5 21:43 上传

点击文件名下载附件

42921783

zhaogang1960 发表于 2014-3-5 21:42

SQL = "select a.订单重量,a.订单运费,a.订单编码,a.重量,a.目的省,a.目的市,a.快递公司,a.库房编码,b.首重收费,b.重量,b.首重,b.首重收费,b.续重1KG,b.上门服务费,b.目的市 from [订单$" _
        & [a1].CurrentRegion.Address(0, 0) & "] a left join [运费标准$] b on a.库房编码=b.库房编码 and a.快递公司=b.快递公司  and  a.目的省=b.目的省"

A.这2个b.首重收费是否重复可以去掉一个。
B.整个语句未完全理解，可否加些注释以便理解。
C.库房编码、快递公司、目的省这3个条件可以匹配出准确结果，过程未能明白，求指导。

zhaogang1960

42921783 发表于 2014-3-6 16:28
SQL = "select a.订单重量,a.订单运费,a.订单编码,a.重量,a.目的省,a.目的市,a.快递公司,a.库房编码,b. ...

写重复了，可以去掉

zhouxiao

42921783 发表于 2014-3-6 16:28
SQL = "select a.订单重量,a.订单运费,a.订单编码,a.重量,a.目的省,a.目的市,a.快递公司,a.库房编码,b. ...

你可以去看一下这个帖子http://club.excelhome.net/thread-1061487-3-1.html,第22楼有你第3个问题的解答

42921783

zhouxiao 发表于 2014-3-6 16:52
你可以去看一下这个帖子http://club.excelhome.net/thread-1061487-3-1.html,第22楼有你第3个问题的解答

A.3个条件不能唯一确定标准啊，重量不同情况下，可能出现不止一种标准。
B.链接所提供的例子，是按姓名一个条件来匹配性别和部门，类似于VLOOKUP。针对本楼问题，如果用函数LOOKUP匹配，除了这3个条件，重量这个条件是要在公式中体现才能准确得出结果吧。链接例子和相应函数可以理解，现在未能理解的是，不完整的3个条件下，是如何能得出准确结果的呢。

zhaogang1960

42921783 发表于 2014-3-6 17:48
A.3个条件不能唯一确定标准啊，重量不同情况下，可能出现不止一种标准。
B.链接所提供的例子，是按姓名一 ...

本题目有5个条件：
目的省        目的市        快递公司        库房编码  订单重量

前4个用来定位行号，是一对多的关系，即相同的条件对应着订单表的多行，有两种情况
不考虑目的市，考虑目的市——通过对应的运费标准表中是否是省内所有来决定用哪一个，且考虑目的市优先
SQL语句先不考虑订单重量，而把所有可能的匹配罗列出来
在众多符合前4个条件的数据中，再用订单重量来判断是否符合条件——If Application.Evaluate(arr(0, i) & arr(9, i)) Then
优先考虑目的市，即有目的市时直接写数据，没有目的市时要先判断改行数据是否已经有数据了，如果有就不再覆盖了

zhaogang1960

去掉那个多余的字段——首重收费：

1. Sub Macro1()
   
2.     Dim cnn, SQL$, a, arr, brr(), i&, j&, s$, d As Object, ds As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set ds = CreateObject("scripting.dictionary")
   
5.     arr = [a1].CurrentRegion
   
6.     ReDim brr(2 To UBound(arr), 1 To 1)
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 8) & arr(i, 7) & arr(i, 5) & arr(i, 1)
   
9.         d(s) = d(s) & "," & i
   
10.         s = arr(i, 8) & arr(i, 7) & arr(i, 5) & arr(i, 1) & arr(i, 6)
    
11.         ds(s) = ds(s) & "," & i
    
12.     Next
    
13.     Set cnn = CreateObject("adodb.connection")
    
14.     cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ActiveWorkbook.FullName
    
15.     SQL = "select a.订单重量,a.订单运费,a.订单编码,a.重量,a.目的省,a.目的市,a.快递公司,a.库房编码,b.重量,b.首重,b.首重收费,b.续重1KG,b.上门服务费,b.目的市 from [订单$" _
    
16.         & [a1].CurrentRegion.Address(0, 0) & "] a left join [运费标准$] b on a.库房编码=b.库房编码 and a.快递公司=b.快递公司  and  a.目的省=b.目的省"
    
17.     arr = cnn.Execute(SQL).GetRows
    
18.     For i = 0 To UBound(arr, 2)
    
19.         If Not IsNull(arr(0, i)) Then
    
20.             If Application.Evaluate(arr(0, i) & arr(8, i)) Then
    
21.                 If arr(13, i) <> "省内所有" Then
    
22.                     a = Split(ds(arr(7, i) & arr(6, i) & arr(4, i) & arr(0, i) & arr(13, i)), ",")
    
23.                     For j = 1 To UBound(a)
    
24.                         brr(Val(a(j)), 1) = arr(10, i) + (arr(0, i) - arr(9, i)) * arr(11, i) + arr(12, i)
    
25.                     Next
    
26.                 Else
    
27.                     a = Split(d(arr(7, i) & arr(6, i) & arr(4, i) & arr(0, i)), ",")
    
28.                     For j = 1 To UBound(a)
    
29.                         If brr(Val(a(j)), 1) = "" Then brr(Val(a(j)), 1) = arr(10, i) + (arr(0, i) - arr(9, i)) * arr(11, i) + arr(12, i)
    
30.                     Next
    
31.                 End If
    
32.             End If
    
33.         End If
    
34.     Next
    
35.     [b2].Resize(UBound(brr) - 1) = brr
    
36.     cnn.Close
    
37.     Set cnn = Nothing
    
38. End Sub
    

复制代码