|
|
楼主 |
发表于 2021-3-12 04:20
|
显示全部楼层
本帖最后由 WYS67 于 2021-3-12 07:22 编辑
老师：还得再麻烦您，看能不能给自定义函数ZDLTXZH和HAOMAZUHE的第一参数n，再次添加一个功能--当指定为"0:9"时，代表数字0~9范围内的所有数字；指定为"01:35"时，则代表为01~35范围内的所有数字？这样，当参数2指定为空时，便可计算并显示指定范围内所有数字的排列组合？
代码如下：
Function HAOMAZUHE(n, Optional 和值 = "", Optional m = "", Optional mode = 1, Optional 个数 = 0, Optional mode2 = 0)
'第一参数:n 指定需要排列组合的元素
' 1.可以指定单元格区域（如D1:M1所示，忽略中间的空格）
' 2.也可以是常量（如{0，1，2，3，7，8，9})
'第二参数:和值 指定号码的和值。缺省=""：无指定
' 1.可以指定单元格区域（如D2:K2所示）
' 2.也可以是常量（如{6,7,8,16,17,18})
'第三参数:m 缺省=""
' mode【参数4】=1、2时：指定组合号码为几位数。
' 1.可以调用单元格指定，也可以用数字指定。
' 2.缺省、时：默认为三位数（即指定数字3）
' mode【参数4】=3时：指定组成号码的元素个数
' 1.可以调用单元格指定，也可以用数字指定。
' 2.缺省时：5（即指定数字5）
'第四参数:mode 缺省=1
' mode【参数4】=1、2时：代表传统型
' 1.可以调用单元格指定，也可以用数字指定。
' 2.当第四参数指定为1或省略时，代表组合号码为符合条件的所有号码（即直选号）；
' 3.当第四参数指定为2时，代表组合号码为符合参数4指定条件的不考虑顺序不可重复(组合)（即组选号）；
' mode【参数4】=3时：代表乐透型
' 1.可以调用单元格指定，也可以用数字指定。
'第五参数:个数 缺省=0
' mode【参数4】=1、2时：指定号码里的元素个数
' 1.可以调用单元格指定，也可以用数字指定。
' 2.当第五参数指定为1，代表号码为1个元素组成，俗称豹子号；
' 3.当第五参数指定为2，代表号码为2个元素组成，俗称组选三；
' 4.当第五参数指定为3，代表号码为3个元素组成，俗称组选六；
' 5.第五参数最多可指定到7（即七星彩），但绝对不会超出第一参数指定的元素总个数，以及第三参数指定的位数！
' 6.第五参数可省略，指定为0或缺省时，默认为符合条件元素的全排列。
' mode【参数4】=3时：指定单、多列显示
' 1.可以调用单元格指定，也可以用数字指定。
' 2.当第五参数指定为0或省略时，单列显示所有的组合号码；
' 3.当第五参数指定为1时，多列显示所有的组合号码。
'第六参数:mode2 显示符合条件的号码或组合注数统计
' 1.可以调用单元格指定，也可以用数字指定。
' 2.当第六参数指定为0或省略时，执行自定义函数原有的所有计算功能，用于组合显示符合条件的号码；
' 3.当第六参数指定为1时，显示指定条件下可以组合的最多注数；
' 4.当第六参数指定为2时，显示指定条件下组合的和值；
' 4.当第六参数指定为3时，显示指定条件下组合的使用元素个数；
Dim crr()
Application.Volatile
h = 和值
hpd = True
If IsArray(h) Then
On Error Resume Next
i = UBound(h, 2)
If Err.Number = 0 Then '二维转一维
ReDim hh(1 To UBound(h) * UBound(h, 2))
i = 0
For Each a In h
If Len(a) > 0 Then '排除空
i = i + 1
hh(i) = a
End If
Next
If i > 0 Then
ReDim Preserve hh(1 To i)
Else
hpd = False
End If
Else
hh = h '一维数组
End If
On Error GoTo 0
ElseIf Len(h) = 0 Then
hpd = False
Else
ReDim hh(1 To 1)
hh(1) = h
End If
If m = "" Then
If mode = 3 Then m = 3 Else m = 5
End If
If mode = 2 Then
arr = ArrPC(n, m, 102, 0, , -个数)
ElseIf mode = 3 Then
arr = ArrPC(n, m, 101, 0, , 0)
Else
arr = ArrPC(n, m, 104, 0, , -个数)
End If
ReDim brr(1 To UBound(arr))
ii = 0
If hpd Then
For i = 1 To UBound(arr)
he = 0
For j = 1 To UBound(arr, 2)
he = he + arr(i, j)
Next
For j = 1 To UBound(hh)
If he = hh(j) Then Exit For
Next
If j <= UBound(hh) Then
ii = ii + 1
brr(ii) = i
End If
Next
Else
For i = 1 To UBound(brr)
brr(i) = i
Next
ii = UBound(brr)
End If
If Application.Version = "11.0" Then '2003版本
N3 = Application.Caller.Rows.Count
C3 = Application.Caller.Columns.Count
Else
gsh = Application.ThisCell.Formula
Do While gsh = Application.ThisCell.Offset(N3, 0).Formula
If Application.ThisCell.Offset(N3, 0).Row = Rows.Count Then Exit Do
N3 = N3 + 1
Loop
Do While gsh = Application.ThisCell.Offset(0, C3).Formula
If Application.ThisCell.Offset(0, C3).Row = Rows.Count Then Exit Do
C3 = C3 + 1
Loop
End If
If mode2 = 0 Then '组合
If mode = 3 Then '乐透型
If ii > N3 Then i2 = N3 Else i2 = ii
If 个数 = 0 Then
ReDim crr(1 To N3, 1 To 1)
For i = 1 To i2
For j = 1 To UBound(arr, 2)
crr(i, 1) = crr(i, 1) & Format(arr(brr(i), j), "00")
Next j, i
For ii = i To N3
crr(ii, 1) = ""
Next
Else
ReDim crr(1 To N3, 1 To C3)
For i = 1 To i2
For j = 1 To UBound(arr, 2)
crr(i, j) = Format(arr(brr(i), j), "00")
Next
For jj = j To C3
crr(i, jj) = ""
Next
Next
For ii = i To N3
For j = 1 To C3
crr(ii, j) = ""
Next j, ii
End If
Else '传统型
If ii > N3 Then i2 = N3 Else i2 = ii
ReDim crr(1 To N3, 1 To 1)
For i = 1 To i2
For j = 1 To UBound(arr, 2)
crr(i, 1) = crr(i, 1) & CStr(arr(brr(i), j))
Next j, i
For ii = i To N3
crr(ii, 1) = ""
Next
End If
HAOMAZUHE = crr
ElseIf mode2 = 1 Then '组合总数
HAOMAZUHE = ii
ElseIf mode2 = 2 Then '和值
If ii > N3 Then i2 = N3 Else i2 = ii
ReDim crr(1 To N3, 1 To 1)
For i = 1 To i2
For j = 1 To UBound(arr, 2)
crr(i, 1) = crr(i, 1) + Val(arr(brr(i), j))
Next j, i
For ii = i To N3
crr(ii, 1) = ""
Next
HAOMAZUHE = crr
ElseIf mode2 = 3 Then '组合使用元素个数
If ii > N3 Then i2 = N3 Else i2 = ii
ReDim crr(1 To N3, 1 To 1)
For i = 1 To i2
ReDim drr(99)
For j = 1 To UBound(arr, 2)
drr(Val(arr(brr(i), j))) = 1
Next
crr(i, 1) = Len(Join(drr, ""))
Next
For ii = i To N3
crr(ii, 1) = ""
Next
HAOMAZUHE = crr
End If
End Function
|
|
楼主: WYS67
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-3-10 21:11
