2014新年元旦第一强帖：实用凑数凑金额高效递归剪枝算法

MouseLhn

牛X，膜拜大神

ivccav

好贴，顶起。虽然对于我来说没有应用场景，但评论已看到15页，评论里很多都是用来发票凑数的。

nsxlyj

香川群子 发表于 2014-1-1 15:07
彭版出的题目的帖子
http://club.excelhome.net/forum.php?mod=viewthread&tid=151178&page=7#pid6353576
...

凑数大法。先做个记号。

jackson.lee

看明白了，真是非常强大，非常实用。

asdd1234

香川大神,46楼的"设置高亮功能"代码复制进sheet1后无效，如果有空的话能不能麻烦看一下哪里有问题。因为确实需要高亮这个功能，先拜谢了！

香川群子

asdd1234 发表于 2018-1-8 12:10
香川大神,46楼的"设置高亮功能"代码复制进sheet1后无效，如果有空的话能不能麻烦看一下哪里有问题。因为确 ...

嗯，测试了一下，当原始数据中含有负数时，确实有问题。

Sheet1中的触发代码修改如下：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     If Target.Column <> 8 Then Exit Sub
   
4.     If Target = "" Then Exit Sub
   
5.    
   
6.     m = Range("A1").End(xlDown).Row
   
7.     Range("A1").Resize(m).Interior.ColorIndex = 0
   
8.     If Target.Row = 1 Then Exit Sub
   
9.    
   
10.     sj = Range("A1").Resize(m)
    
11.     s = Target.Text
    
12.     i1 = 1
    
13.     For i = 2 To Len(s)
    
14.         t = Mid(s, i, 1)
    
15.         If Not IsNumeric(t) Then '="+" or "-"
    
16.             t = Val(Mid(s, i1, i - i1 + 1))
    
17.             For i2 = 2 To m
    
18.                 If sj(i2, 1) = t Then sj(i2, 1) = "": Exit For
    
19.             Next
    
20.             i1 = i
    
21.         End If
    
22.     Next
    
23.    
    
24.     For i = 2 To m
    
25.         If sj(i, 1) = "" Then Cells(i, 1).Interior.ColorIndex = 6
    
26.     Next
    
27.    
    
28. End Sub

复制代码

yangliugyl

香川群子 发表于 2018-1-8 15:11
嗯，测试了一下，当原始数据中含有负数时，确实有问题。

Sheet1中的触发代码修改如下：

川姐，不好意意打扰你一下，我用你的方法，提示运行时错误 6,溢出，能向你咨询下吗，顺便能求下你的微信或QQ吗，不胜感激

香川群子

yangliugyl 发表于 2018-1-9 22:32
川姐，不好意意打扰你一下，我用你的方法，提示运行时错误 6,溢出，能向你咨询下吗，顺便能求下你的微信 ...

如果数据都很大，超过长整型数值范围，就会提示溢出。

这时候，应该设置小数位为负数，进行模糊计算。

你可以上传附件。我帮你看一下。

我的电脑的

用上了，不得不说楼主真厉害，必须感谢，你是个大美女

feixiangye

香川群子 发表于 2018-1-10 08:24
如果数据都很大，超过长整型数值范围，就会提示溢出。

这时候，应该设置小数位为负数，进行模糊计算。 ...

香川老师,非常感谢您分享的这个高效凑数程序,在工作中经常用到节约了很多时间,工作中这组数只要运行下程序excel就会死机,烦请帮忙看下是什么原因,我研究了好久百思不得其解,谢谢！