作业帮 > 综合 > 作业

求助一段VBA代码,循环组合

来源:学生作业帮 编辑:作业帮 分类:综合作业 时间:2024/05/12 14:19:10
求助一段VBA代码,循环组合
条件:在单元格E2至E3区域中(E1为标题),单元格内容分别是:E2=3128,E3=6754
要求:1、固定取E2的第四位作一个数,再在E2的其他三位及E3的一至三位共6位中任意取三位分别作三个数,将这四个数相加,取结果的个位数放在G2单元格.
2、固定取E3的第四位作一个数,再把第1点6位数其中未相加的三位数分别作三个数,将这四个数相加,取结果的个位数放在G3单元格.
3、总结,E列双行数据循环组合(各第四位做固定数不参与循环组合)操作结果有20个,依次放在G-Z区域
4、接着循环组合E4至E5区域,
5、循环至E区域为空.
为方便使用,根据需求自定义一个函数,在工作表中可以象内置函数一样任意引用,非常方便.
Function SHuangZuheWei(ingA As Integer, ingB As Integer, ingHexu As Integer, booBoolean As Boolean) As Integer
函数返回的是一个新数的十位或个位.ingA 是第一个数(E2),ingB是第二个数(E3),ingHexu 是1-20范围内的自然数,表示函数返回的是第 ingHexu 个新数的十位或个位,booBoolean 是布尔参数,值 True 表示函数返回新数的十位,值 False 表示返回函数个位.
在代码编辑器里插入一个模块,将下面的函数代码粘贴到刚插入的模块里,保存即可在工作表里引用了.
Function SHuangZuheWei(ingA As Integer, ingB As Integer, _
ingHexu As Integer, booBoolean As Boolean) As Integer

'声明循环变量
Dim I As Integer
Dim J As Integer
Dim K As Integer

'声明新数计数变量
Dim N As Integer
'声明保存两个数的各位的数组变量
Dim arrWeiA(1 To 4) As Integer
Dim arrWeiB(1 To 4) As Integer

'声明保存参与组合的6个数的数组变量
Dim arrJiashu(1 To 6) As Integer
'声明分别保存新数十位与个位的数组变量
Dim arrJiashuA(1 To 20) As Integer
Dim arrJiashuB(1 To 20) As Integer
'防错:多余4位截取低4位,不足4位高4位补0
ingA = Val(Right("000" & CStr(ingA), 4))
ingB = Val(Right("000" & CStr(ingB), 4))

'提取两个四位数的各位
For I = 1 To 4
arrWeiA(I) = Mid(ingA, I, 1)
arrWeiB(I) = Mid(ingB, I, 1)
Next I
'提取两个四位数的低3位作为6个供组合的加数
For I = 1 To 3
arrJiashu(I) = arrWeiA(I + 1)
Next I
For I = 4 To 6
arrJiashu(I) = arrWeiB(I - 2)
Next I
'循环组合
For I = 1 To 4
For J = I + 1 To 5
For K = J + 1 To 6
N = N + 1
'组合求和
arrJiashuA(N) = arrWeiA(1) + arrJiashu(I) _
+ arrJiashu(J) + arrJiashu(K)
arrJiashuB(N) = arrWeiB(1) + arrJiashu(I) _
+ arrJiashu(J) + arrJiashu(K)

Next K
Next J
Next I

If ingHexu > 0 And ingHexu < 21 Then
If booBoolean = True Then
'返回所有新数组合中第 ingHexu (整参)个新数十位
SHuangZuheWei = Val(Right(arrJiashuA(ingHexu), 1))
Else
'返回所有新数组合中第 ingHexu (整参)个新数个位
SHuangZuheWei = Val(Right(arrJiashuB(ingHexu), 1))
End If
Else
'设置错误,以便函数捕获超出范围错误
SHuangZuheWei = ""
End If

End Function
下面按提问者的要求以 SHuangZuheWei 自定义函数的使用为例简述如下:
ingA、ingB两数分别放在E2、E3单元格.要求所有的组合出的新数的十位放在G2:Z2的区域;个位放在G3:Z3的区域.数据两行一组,往下填充.
则在G2单元格输入公式:
=SHuangZuheWei($E2,$E3,COLUMN(G2)-COLUMN($G2)+1,TRUE)
在G3单元格输入公式:
=SHuangZuheWei($E2,$E3,COLUMN(G3)-COLUMN($G3)+1,FALSE)
说明:公式中的表达式 COLUMN(G2)-COLUMN($G2)+1 返回一个1-20范围内的自然数.表示当前单元格所在的列号(变动的)与固定的G列的列号之差加1.
然后将G2:G3区域往有填充复制至Z2:Z3;再将G2:Z3区域往下填充至E列数据的末端(最下面).
OK!大功告成!