【代码】数组动态扩展、字典综合应用：订单金额达标插入赠品！
文摘
教育
2024-10-21 23:47
江苏
1、在工作表“订单明细”里，命令按钮点击事件、工作表Change事件，调用相应过程：Private Sub CmdFreeGift_Click() Call freeGiftEnd Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$J$1" Then Call freeGift End IfEnd Sub
2、在myModule里，freeGift过程，根据订单金额插入赠品：Sub freeGift() Dim i As Long, j As Long, k As Long Dim ws As Worksheet, lRow As Integer, lCol As Integer Dim rng As Range, minAmount As Double Dim dic As Object, dSum As Object, orderNo As Variant Dim arr(), gift(), temp(), item Set dic = CreateObject("Scripting.Dictionary") Set dSum = CreateObject("Scripting.Dictionary") '//把赠品装入数组gift Set ws = ThisWorkbook.Sheets("赠品") With ws lRow = .UsedRange.Rows.Count lCol = 6 gift = .Range(.Cells(2, 1), .Cells(lRow, lCol)).Value End With '//把订单明细装入数组arr Set ws = ThisWorkbook.Sheets("订单明细") With ws minAmount = .Range("J1").Value lRow = .UsedRange.Rows.Count If lRow <= 2 Then Exit Sub '//没有数据退出 lCol = 6 Set rng = .Cells(1, 1).Resize(lRow, lCol) arr = rng.Value End With '//循环数组，把订单数据装入字典 For i = 2 To lRow orderNo = arr(i, 1) If orderNo <> "" And InStr(orderNo, "赠品") = 0 Then dSum(orderNo) = dSum(orderNo) + arr(i, 5) If Not dic.exists(orderNo) Then k = 1 Else temp = dic(orderNo) k = UBound(temp, 2) + 1 End If ReDim Preserve temp(1 To lCol, 1 To k) For j = 1 To lCol temp(j, k) = arr(i, j) Next dic(orderNo) = temp End If Next
第二部分、根据订单金额合计，在满足条件的订单数据中添加赠品，再把字典dic的所有数据写入工作表“最终效果”： '//循环字典，根据dSum中的汇总金额来确定是否添加赠品 For Each orderNo In dSum.keys If dSum(orderNo) >= minAmount Then temp = dic(orderNo) k = UBound(temp, 2) + UBound(gift) ReDim Preserve temp(1 To lCol, 1 To k) For i = 1 To UBound(gift) For j = 1 To lCol temp(j, k - UBound(gift) + i) = gift(i, j) Next Next dic(orderNo) = temp End If Next '//把字典内容写入工作表 Set ws = ThisWorkbook.Sheets("最终效果") ws.UsedRange.Offset(1).ClearContents i = 2 With ws For Each item In dic.items j = UBound(item, 2) .Cells(i, 1).Resize(j, lCol) = Application.Transpose(item) i = i + j + 1 Next .Columns("C:F").HorizontalAlignment = xlCenter .Columns("F").Font.Bold = True .Activate End WithEnd Sub
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
