源起

以前自己做过一个凑发票的delphi程序，最近要用翻出来结果发现总额只能是整数，所以就在网上搜了搜，发现百度经验里头有个用excel VBA来凑发票的小程序，试了一下还可以，不过他的误差是上下限统一，但实际用的时候一般都要求不能低于指定金额，但程序算出来的往往是小于需要金额的，所以顺手改了一下。本来想直接在经验里头回复，可找不到贴的地方，就顺手放这里了。
另外，顺手改了提示和发票数量0的小bug。

原链接地址
https://jingyan.baidu.com/article/358570f69de212ce4724fc00.html

程序如下：

Sub MP()

Sheet1.Range("E2") = ""Dim csh As DoubleDim brr() As DoubleDim SS As IntegerDim MM As IntegerDim HH As IntegerSS = Second(Time)MM = Minute(Time)HH = Hour(Time)Dim diff As Double

Dim diff1 As Double

diff = Sheet1.Cells(4, 4)diff = Sheet1.Cells(2, 4)Dim zoci As DoubleDim ci As IntegerDim DeVa As DoubleDim Weiba As IntegerDeVa = Sheet1.Cells(2, 3)Dim jar As DoubleDim arr() As DoubleDim tot As Doublezoci = 0ci = 0jar = 0Weiba = Sheet1.Cells(3000, 2).End(xlUp).RowIf Weiba < 2 Then
MsgBox ("数据不足，无法运算！")
Exit SubEnd IfReDim arr(2 To Weiba)ReDim brr(1 To Weiba)Dim MaVa As DoubleDim SeLaVa As Doublebrr(1) = 0For i = 2 To Weibaarr(i) = Sheet1.Cells(i, 2)brr(i) = arr(i)Next

For i = 2 To Weiba - 1

    For p = i + 1 To WeibaIf brr(i) > brr(p) Thencsh = brr(i)brr(i) = brr(p)brr(p) = cshEnd IfNext

For i = 2 To WeibaSheet1.Cells(i, 2) = brr(Weiba + 2 - i)Next

For i = 1 To Weiba

    tot = tot + brr(i)

For i = 2 To Weiba

    MaVa = MaVa + brr(i)

    SeLaVa = MaVa - brr(2)If (DeVa >= brr(2) And DeVa <= SeLaVa) Or DeVa = MaVa ThenCall SB(DeVa, Weiba, 2, jar, ci, zoci, diff, diff1, arr(), brr(), tot)ElseMsgBox "金额超限啦！请更改需求值或添加发票！"End IfIf Cells(2, 5) = 0 Then MsgBox "现有发票无法凑出所需金额，请增加发票数或增加误差值!" Else MsgBox "计算完成，耗时：" & Second(Time) - SS + (Minute(Time) - MM) * 60 + (Hour(Time) - HH) * 3600 & "秒"

End Sub

Sub SB(DeVa As Double, Weiba As Integer, x As Integer, jar As Double, ci As Integer, zoci As Double, diff As Double, diff1 As Double, arr() As Double, brr() As Double, tot As Double)

Dim caob As DoubleStatic caomm As IntegerFor i = x To Weibaci = ci + 1zoci = zoci + 1jar = jar + arr(i)Sheet1.Cells(i, 2).Interior.ColorIndex = 37'Debug.Print zoci & "层次=" & ci & " " & "i=" & i & " " & "上一个jar=" & jar - Sheet1.Cells(i, 2), "jar=" & jarIf jar <= DeVa + diff And jar >= DeVa - diff1 ThenSheet1.Cells(2, 5) = jarExit SubEnd IfIf jar < DeVa + diff Then Call SB(DeVa, Weiba, i + 1, jar, ci, zoci, diff, diff1, arr(), brr(), tot)If jar <= DeVa + diff And jar >= DeVa - diff1 ThenSheet1.Cells(2, 5) = jarExit ForEnd IfSheet1.Cells(i, 2).Interior.ColorIndex = -4142jar = jar - arr(i)ci = ci - 1Next

End Sub

【百度经验中excel VBA凑发票程序修改版】相关推荐

EXCEL VBA常用语句100句
以下转自:http://www.bbioo.com/blog/bio/guohui/1524.htm EXCEL VBA常用语句100句定制模块行为 Option Explicit '强制对模块内所 ...
如何避免在Excel VBA中使用选择
本文翻译自:How to avoid using Select in Excel VBA I've heard much about the understandable abhorrence of ...
Excel VBA中的等价(Eqv)和蕴含(Imp)
在一般的编程语言中,逻辑运算只有四个 - Not - And - Or - Xor 但在Excel VBA中,还有 - Eqv 逻辑等价 - Imp 逻辑蕴含他们的真值表如下现给逻辑等价Eqv和逻 ...
Excel VBA开发中数字签名的管理
Excel 禁用无数字签署的宏网上下载的Excel文件可能含有宏病毒,因此打开Excel文件时最好不要轻易启动宏,同时为了不让"启动宏"的提示每次出现,可以在Excel设置中提高 ...
vba编程把纯文本转换成html,如何将一列文本与html标签转换为Excel中的vba格式文本...
我想知道如何使用VBA脚本将带有html标签的整列单元转换为格式化文本(基于这些标签).如何将一列文本与html标签转换为Excel中的vba格式文本使用下列内容: Sub Sample() Dim ...
excel vba 使用mschart_VBA专题108：使用VBA操控Excel界面之在功能区中添加内置控件...
学习Excel技术,关注微信公众号: excelperfect 本文重点讲解如何在功能区中添加不同类型的内置控件. 添加普通按钮和切换按钮按下面的步骤来添加普通按钮和切换按钮(例如,拼写和删除线控件 ...
工具推荐：用VS code 导出、导入和运行Excel中的VBA代码
问题如何使用Excel的VBA 编辑器以外的IDE来编辑VBA代码? 如何导入/导出Excel中的VBA代码? 我能不能在Excel以外的地方运行VBA代码? 如何把Excel中的VBA工程/代码上 ...
EXCEL VBA 中关于斗牛的算法
EXCEL VBA 中关于斗牛的算法初学EXCEL VBA,只能用最简单的穷举法来算斗牛了.具体规则是,5个数字,任意3个数字相加为10的倍数,其他两个数字相加,大于10则减去10,小于10则为牛几 ...
python打开excel执行vba代码_“Python替代Excel Vba”系列（终）：vba中调用Python
请关注本号,后续会有更多相关教程. 系列文章学Python还不会处理Excel数据?带你用pandas玩转各种数据处理"Python替代Excel Vba"系列(二):panda ...

【百度经验中excel VBA凑发票程序修改版】

百度经验中excel VBA凑发票程序修改版

源起

程序如下：

【百度经验中excel VBA凑发票程序修改版】相关推荐

最新文章

热门文章