本文于2023年3月27日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！
在我的《财务管理系统》里，在增加或编辑会计科目的时候，会有一个核算项目的选择：
简单说明一下：
为了演示，我把列宽都缩小了，可以再恢复成原样。
当我们双击一个科目的核算项目栏，准备修改的时候，它会判断这个科目有没有被使用过，使用过就不能修改了。
我们在设置科目核算项目的时候，一个科目可能会设置1个以上的核算项目，表示方式就是把核算项目分类代码通过分隔符连接起来，比如"XJ/BM/RY"，表示这个科目设有"现金流量、部门和人员"3个核算项目，我这里的核算项目分类代码是两个字母，举例：
XJ=现金流量项目，用来核算现金流量，一般适用于现金、银行科目
BM=部门核算，用来按部门核算，一般用于收入、成本、费用类科目
RY=人员核算，可用于个人往来类科目，比如其他应收、其他应付类科目，费用类科目等
KS=客商核算，用于客户、供应商类的往来科目，比如应收、应付账款等。
有了这些个想法与需求，如何在我的《财务管理系统》中实现这样的功能？
刚开始想不出好办法，那就手工输入吧，但这样容易出错，也显得很不专业，经过一段时间的冥思苦想以后，终于找到了解决方法：
1、把"核算项目分类"读取到一个数组arr()中
2、把所有核算项目分类进行组合，存到数组comArr()中
3、然后再把comArr加到Combox的list中供选择输入，这样一般就不会出错了。贴一段代码，这里重点是：.List = arrType，这里的arrType就相当于前文的comArr
ElseIf CurrTable = "tb科目" Then '会计科目设置
If Me.LvDetail.ColumnHeaders(intCol) = "核算项目" Then
IfclsGT.IsAccInUse(Me.LvDetail.SelectedItem.SubItems(Pxy(Tbtitle,"科目代码")-1))Then
MsgBox "科目已被使用，核算项目不能更改，请新增相关科目设置所需核算项目！"
InkEdit1.Width = 0
Exit Sub
End If
With Usf_Interm
.Caption = "选择【核算项目】"
sql = " Select distinct 项目分类码 from tb核算项目"
If clsDQ.RecordValue("select count(*) from tb核算项目") = 0 Then
MsgBox "无核算项目，请添加后再操作"
Exit Sub
End If
arr = clsDQ.GetData(sql)
iRow = UBound(arr, 2)
ReDim arrTem(iRow)
For i = 0 To iRow
arrTem(i) = arr(0, i)
Next
'旧的函数arrType=clsCF.GetArrElementsComb(arrTem,"/")
arrType = CombineArray(arrTem, "/")
WithUsf_Interm.CmbInterm
.Clear
.List = arrType
.Width = 150
.Text = Me.InkEdit1.Text
End With
.Width = .CmbInterm.Width .CmdConfirm.Width 20
.CmdConfirm.Left = .CmbInterm.Left .CmbInterm.Width 2
.Show
End With
这段代码判断点击的列是核算项目，再判断科目是否被使用，已使用则退出过程，未使用则显示窗体Usf_Interm，并对该窗体中的Combox:CmbInterm进行一系列操作，把所有可能的核算项目组合列出来供选择。
关于数组元素组合的自定义函数分享给大家：
Function CombineArray(arr As Variant, Optional delimiter As String = "/") As Variant
'将一维数组中的所有元素进行组合
Dim n As Long, i As Long, j As Long, k As Long, count As Long
Dim result(), temp As String
n = UBound(arr) - LBound(arr) 1 '计算数组长度
count = 2 ^ n - 1 '计算组合数
ReDim result(1 To count) '初始化结果数组
For i = 1 To count '遍历所有组合
temp = ""
For j = 0 To n - 1
If i And 2 ^ j Then '根据位运算判断元素是否出现
temp = temp & arr(LBound(arr) j) & delimiter '将元素值用逗号隔开拼接成字符串
End If
Next
result(i) = Left(temp, Len(temp) - Len(delimiter)) '去除字符串末尾的分隔符
Next
'按长度和字符排序
For i = 1 To count - 1
For j = i 1 To count
If Len(result(i)) > Len(result(j)) Then '按长度排序
temp = result(i)
result(i) = result(j)
result(j) = temp
ElseIf Len(result(i)) = Len(result(j)) And result(i) > result(j) Then '按字符排序
temp = result(i)
result(i) = result(j)
result(j) = temp
End If
Next
Next
CombineArray = result '返回结果数组
End Function
其实，今天写这篇文章的原因跟前文Excel VBA 数组应用/查询凭证空号/VBA代码优化/AI辅助是一样的，都是跟AI学到了更优的代码逻辑，想把它分享给大家。这个函数基本上是AI写的，我只做了一点修改，在Dim result()处，它原来是Dim result() as string，在运行的时候报错，类型不匹配，把 as string删除就好了。
旧的函数clsCF.GetArrElementsComb()，代码就不贴了，我自己现在看它都有点头晕，也不想去梳理它的逻辑了，当初也是绞尽脑汁啊，现在一想头都疼。虽然它运行的结果是正确的，但有点小瑕疵，组合后的元素顺序有点乱：
所以，总想着怎么给它改改，昨天终于有机会咨询了一下AI，它也给了好多方法，只有目前的Function CombineArray能正常运行。
这个自定义函数是针对一维数组的，如果是二维数组，要先把它转成一维数组后再组合，（本来也想直接把二维数组直接进行组合，或者不论几维都直接给它组合了，代码搞了一大堆，然并卵，只好作罢，虽然从逻辑上看来并不复杂）
二维数组转一维也可以写一个自定义函数：
Function FlattenArray(arr As Variant) As Variant
' 将二维数组转换成一维数组
Dim iCol As Integer, iRow As Integer
Dim FlattenedArr(), Lbnd As Integer
iRow = UBound(arr, 1)
iCol = UBound(arr, 2)
Lbnd = LBound(arr, 1)
For i = Lbnd To iRow
For j = Lbnd To iCol
ReDim Preserve FlattenedArr(k)
FlattenedArr(k) = arr(i, j)
k = k 1
Next
Next
FlattenArray = FlattenedArr
End Function
这个函数也是参考AI的，不过它给的代码是先把FlattenedArr的总大小确定，然后再循环赋值，逻辑没有问题，但在赋值的时候运行不正常，也不去管它了，我原来的函数里就有把二维数组转成一维数组的代码，拿来改改就成。所以，这个函数AI只贡献了一个函数名称。
如果仍然想不论是一维还是二维（我们不考虑其他维，目前从未碰到），那么还需要写一个判断数组是一维还是二维的函数。然后修改这个CombineArray的代码，先判断arr是一维还是二维，如果是二维再把它转换成一维，然后再组合，代码我就不写了，可能还要增加一个临时数组arrTem用来存放arr参数的转换结果，并把它作为后续代码的转换目标，即我们不对arr进行组合，转而对arrTem进行组合。
我还注意到，在CombineArray中有这么一句代码If i And 2 ^ j Then '根据位运算判断元素是否出现，什么是位运算？跟AI也聊了，还是没有太明白，于是上网去搜吧，跟AI说的差不多，不过有一些倒是让我有点明白了在这里用"位运算"的逻辑，就是位运算求子集的问题，我的所谓的核算项目代码组合不就是一个求子集的问题吗？虽然还是没完全搞懂，但起码了解了一些位运算的知识与应用，起码我的问题需求已完美解决，不再进一步深究了，"实用致上"嘛，有机会再研究。
好了，今天就分享到这里，我们下期再见.
本文于2023年3月27日首发于本人同名公众号：Excel活学活用，更多文章敬请关注！
