返回列表 上一主題 發帖

[發問] 兩種不同條件的運費計算如何合併

[發問] 兩種不同條件的運費計算如何合併

兩種不同條件的運費計算如何合併,懇請前輩指點,感恩.

運費計算.rar (8.44 KB)

杜小平

本帖最後由 dou10801 於 2022-5-20 16:33 編輯

回復 1# dou10801 更正[張三]合計運費,位置放錯,抱歉.
1110520.jpg

運費計算1.rar (8.46 KB)

杜小平

TOP

本帖最後由 hcm19522 於 2022-5-21 10:05 編輯

https://blog.xuite.net/hcm19522/twblog/590390712
隨意窩 "EXCEL迷"  blog  或https://blog.xuite.net/hcm19522/twblog
已收集8500篇 EXCEL函數

TOP

回復 2# dou10801

運費計算.zip (62.64 KB)

TOP

感謝:hcm19522和singo1232001先進,收下學習,感恩.
杜小平

TOP

回復 2# dou10801

請測試看看,謝謝

運費計算_0527.zip (15.52 KB)

TOP

本帖最後由 samwang 於 2022-5-27 21:16 編輯

回復 4# singo1232001

Singo1232001您好,
剛剛測試了一下您的程式,新增人數會有問題如圖片,另外合計運費也是有點問題
請再確認,謝謝
1.JPG

TOP

回復 7# samwang


    Sub test()

Set d = CreateObject("scripting.dictionary")
Set d0 = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
  rw = Cells(Rows.Count, 1).End(3).Row
   ar = Range("a2:G" & rw)
    [N:R].ClearContents
   
For i = 1 To UBound(ar)
ar(i, 6) = "": ar(i, 7) = ""
If ar(i, 4) <= 10 Then ar(i, 6) = 0: ar(i, 7) = ar(i, 3) * 15
If ar(i, 4) > 10 Then ar(i, 6) = 1: ar(i, 7) = ar(i, 5) * 2
If d.exists(ar(i, 1)) = False Then Set d(ar(i, 1)) = CreateObject("scripting.dictionary")
     d(ar(i, 1))("件") = d(ar(i, 1))("件") + ar(i, 3)
      d(ar(i, 1))("重") = d(ar(i, 1))("重") + ar(i, 5)
       d(ar(i, 1))("費") = d(ar(i, 1))("費") + ar(i, 7)
    d0(ar(i, 1)) = d0.Count
     d1(ar(i, 2)) = d1.Count
Next

ReDim br(0 To d.Count - 1, 1 To 4)
For i = 0 To d.Count - 1
br(i, 1) = d.keys()(i)
br(i, 2) = d(br(i, 1))("件")
  br(i, 3) = d(br(i, 1))("重")
   br(i, 4) = d(br(i, 1))("費")
Next

Set Rng = [N1]
Rng.Resize(1, 4) = Array("出貨人", "總件數", "總重量", "合計運費")
  Rng.Offset(1, 0).Resize(UBound(br) + 1, 4) = br



ReDim cr(1 To d.Count)  '建陣列 3+2維
ReDim dr(1 To d1.Count * d.Count)
  ReDim er(0 To 1)   '
   ReDim fr(0 To 1000, 0 To 5)
    For i = 1 To UBound(cr)
     cr(i) = dr
      For j = 1 To UBound(cr(i))
        cr(i)(j) = er
        For k = 0 To 1
          cr(i)(j)(k) = fr
          cr(i)(j)(k)(0, 0) = 0
        Next
      Next
    Next

For i = 1 To UBound(ar)   '放資料
i0 = d0(ar(i, 1))   '姓名
  j = d1(ar(i, 2))   '水果
   k = ar(i, 6)      '0小於10公斤    1大於10公斤
   cr(i0)(j)(k)(0, 0) = cr(i0)(j)(k)(0, 0) + 1
    w = cr(i0)(j)(k)(0, 0)
cr(i0)(j)(k)(w, 1) = ar(i, 1)
cr(i0)(j)(k)(w, 2) = ar(i, 2)
  cr(i0)(j)(k)(w, 3) = ar(i, 3)
   cr(i0)(j)(k)(w, 4) = ar(i, 4)
    cr(i0)(j)(k)(w, 5) = ar(i, 5)
Next

For i = 1 To UBound(cr)   '資料貼工作表
For j = 1 To UBound(cr(i))
  For k = 0 To 1
    r0 = Cells(Rows.Count, Rng.Column + 1).End(3).Row + 2
    If cr(i)(j)(k)(0, 0) <> 0 Then
        a3 = 0: a4 = 0: a5 = 0
        For L = 1 To cr(i)(j)(k)(0, 0)
        a3 = a3 + cr(i)(j)(k)(L, 3)
         a4 = a4 + cr(i)(j)(k)(L, 4)
          a5 = a5 + cr(i)(j)(k)(L, 5)
        Next
        Cells(r0, Rng.Column - 1).Resize(cr(i)(j)(k)(0, 0) + 1, 6) = cr(i)(j)(k)
         Cells(r0, Rng.Column - 1).Resize(1, 6) = Array(Cells(r0, Rng.Column), "出貨人", "品名", "件數", "件重/ kg", "總重量")
          Cells(Cells(Rows.Count, "Q").End(3).Row + 1, "M").Resize(1, 6) = Array("", "", "", a3, a4, a5)
    End If
  Next
Next
Next

End Sub

TOP

回復 7# samwang 感謝samwang先進,是我需求數字,感恩.
杜小平

TOP

        靜思自在 : 地上種了菜,就不易長草;心中有善,就不易生惡。
返回列表 上一主題