ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 540|回复: 18

[求助] 应该是最简单的发票凑数,期望递归法指导

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-23 20:42 | 显示全部楼层 |阅读模式
本帖最后由 罗达 于 2020-1-23 20:48 编辑
  1. Sub 细分复合法()        '用细分金额倒装如数组方法分割金额
  2. Dim arra(), arrb(), arrk(), arrt()
  3. Dim arr, k&, x&, y&, dic, a!, b!, c$, e!

  4. arr = Worksheets("出库表").UsedRange
  5. With Worksheets("分割提取")
  6.     a = .[B2]       '税率
  7.     b = .[f2]       '上限额度
  8.     c = .[i2]       '客户单位
  9.     e = .[o2]       '误差额度
  10. End With

  11. For k = 2 To UBound(arr)           '将符合条件的数据按误差限额细分装入数组
  12.     If arr(k, 20) = a And arr(k, 21) = c And arr(k, 25) = "已回票" Then
  13.         m = Application.RoundUp(arr(k, 19) / e, 0)      '细分循环次数
  14.         n = n + m
  15.         
  16.         ReDim Preserve arra(1 To 3, 1 To n)             '申明动态数组保留原值
  17.                 i = UBound(arra, 2)       '从数组最大序号开始倒序装入细分数据
  18.                 'arra(1, i) = kk                 '发票号
  19.                 arra(2, i) = k                  '原数据行号
  20.                 If (arr(k, 19) Mod e) > 0 Then
  21.                     arra(3, i) = arr(k, 19) Mod e        '细分金额尾数
  22.                 Else
  23.                     arra(3, i) = e
  24.                 End If
  25.             For x = UBound(arra, 2) - 1 To UBound(arra, 2) - m + 1 Step -1
  26.                 'arra(1, i) = kk                 '发票号
  27.                 arra(2, x) = k                 '原数据行号
  28.                 arra(3, x) = e                   '细分金额
  29.             Next
  30.     End If
  31. Next

  32. x = 0
  33. For x = 1 To UBound(arra, 2)      '累加求得各行发票序号
  34.     j = j + arra(3, x)
  35.    
  36.     If j < (b * (1 + a) * (kk + 1) - e) Then
  37.         arra(1, x) = kk + 1
  38.     ElseIf j >= (b * (1 + a) * (kk + 1) - e) Then
  39.         kk = kk + 1
  40.         arra(1, x) = kk + 1
  41.     End If
  42. Next

  43. Set dic = CreateObject("Scripting.Dictionary")
  44. x = 0
  45. For x = 1 To UBound(arra, 2)
  46.     dic(arra(1, x) & "|" & arra(2, x)) = dic(arra(1, x) & "|" & arra(2, x)) + arra(3, x)
  47. Next

  48. ReDim arrk(1 To dic.Count)
  49. ReDim arrt(1 To dic.Count)
  50. ReDim arrb(1 To dic.Count, 1 To 17)
  51. arrk = dic.keys
  52. arrt = dic.items

  53. x = 0: i = 0: j = 0         '将分割结果数据补充完整放入数组arrb
  54. For x = 0 To UBound(arrk)
  55.     i = arrk(x)
  56.     j = Right(i, Len(i) - Application.Find("|", i))  '行号
  57.     arrb(x + 1, 1) = Left(i, Application.Find("|", i) - 1) '发票号-序号
  58.     arrb(x + 1, 2) = arr(j, 4)    '品名
  59.     arrb(x + 1, 3) = arr(j, 6)    '产地
  60.     arrb(x + 1, 4) = arr(j, 7)    '规格
  61.     arrb(x + 1, 5) = arr(j, 8)    '单位
  62.    
  63.     arrb(x + 1, 7) = arr(j, 18)   '含税单价
  64.     arrb(x + 1, 8) = arrt(x)    '含税金额
  65.     arrb(x + 1, 9) = arr(j, 20)  '税率
  66.    
  67.     arrb(x + 1, 6) = Application.Round(arrb(x + 1, 8) / arrb(x + 1, 7), 4) '数量
  68.     arrb(x + 1, 10) = Application.Round(arrb(x + 1, 8) / (1 + arrb(x + 1, 9)) * arrb(x + 1, 9), 2) '税额
  69.     arrb(x + 1, 11) = arrb(x + 1, 8) - arrb(x + 1, 10) '不含税金额
  70.    
  71.     arrb(x + 1, 12) = arr(j, 5)    '生产批号
  72.     arrb(x + 1, 13) = arr(j, 3)    '来货批次
  73.     arrb(x + 1, 14) = arr(j, 2)    '发货日期
  74.     arrb(x + 1, 15) = ""           '备注
  75.     arrb(x + 1, 16) = c           '购货单位....需换成全称
  76.     arrb(x + 1, 17) = ""          '开票年月
  77.     arr(j, 25) = "已开票"
  78. Next
  79. Application.ScreenUpdating = False
  80. With Worksheets("分割提取")     '将分割后的完整数据写入工作表
  81.     y = .Range("a65536").End(xlUp).Row
  82.         .Range("a" & y + 1).Resize(UBound(arrb), 17) = arrb
  83. End With
  84. i = 0
  85. With Worksheets("出库表")       '将已开票的金额回写注明
  86.     For i = 1 To UBound(arr)
  87.         If arr(i, 25) = "已开票" Then
  88.             .Range("Y" & i) = arr(i, 25)
  89.         End If
  90.     Next
  91. End With
  92. Application.ScreenUpdating = True
  93. End Sub
复制代码

有个发货记录,用其开税票。以前硬写了一个,是将金额全部分割成很小的数值,再用字典取,过程代码冗余较慢。现在想用递归写一个,请赐教。
凑数求助.zip (16.47 KB, 下载次数: 20)
image.png

TA的精华主题

TA的得分主题

发表于 2020-1-23 21:41 来自手机 | 显示全部楼层
关于凑数的处理,建议你搜索一下香川裙子的一个帖子,非常棒。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-23 22:20 | 显示全部楼层
likaiyihou 发表于 2020-1-23 21:41
关于凑数的处理,建议你搜索一下香川裙子的一个帖子,非常棒。

看了香川老师的几个关于递归的帖子,看得一知半解,更是写不出来。和一般的凑数有区别,就不会改了。感谢帮助

TA的精华主题

TA的得分主题

发表于 2020-1-23 23:13 | 显示全部楼层
罗达 发表于 2020-1-23 22:20
看了香川老师的几个关于递归的帖子,看得一知半解,更是写不出来。和一般的凑数有区别,就不会改了。感谢 ...

你这个可分割,就简单了。循环即可

TA的精华主题

TA的得分主题

发表于 2020-1-24 07:54 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-24 11:33 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-1 19:45 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-2-1 19:56 | 显示全部楼层
本帖最后由 micch 于 2020-2-1 20:00 编辑

凑数的意思是,所有符合条件的数,组合在一起凑出110000的和值,尽量得到组合数最少的结果,也就是乱序凑数,

你的要求是按数据的原始顺序凑数,那第一个数只能和第2,3,4个数凑,那就不需要递归了,而且你的模拟结果,金额是可以拆分,也就是,组合的结果必然是110000,这个完全是分割而不是凑数


按你的结果,好写,不过前提是税率一致的金额都可以自由组合,这个和实际情况需要呼应才行。实际开票时,同一公司的勉强还能开一起,不同公司是不能开一起的。即使是同一公式不同订单,既然可以拆分金额,那就完全可以按总金额开票,110000一张,开到不足110000为止。

TA的精华主题

TA的得分主题

发表于 2020-2-1 21:14 | 显示全部楼层
我有个给定金额,开出最少发票的代码,不知对你是否有用?

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-2 11:06 | 显示全部楼层
micch 发表于 2020-2-1 19:56
凑数的意思是,所有符合条件的数,组合在一起凑出110000的和值,尽量得到组合数最少的结果,也就是乱序凑数 ...

谢谢M老师关注,正如您说的一样,实际开票有多个条件筛选(税率、客户相同)数据,顺序分割-凑数,而且还设有允许误差值,不完全是按照满值开票。其他的和您说的一样。我有一个公式版的,后改写成了更简便的V版。这次求助也是想一个更高效的思路,我发的代码效率很低。再次感谢
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-6-3 02:51 , Processed in 0.094042 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表