创建按指定条件组合数字的自定义函数

WYS67

yjh_27 发表于 2021-3-20 10:56
已更新。重新下载

万分感谢老师！

WYS67

yjh_27 发表于 2021-3-20 10:56
已更新。重新下载

給LTXPL和LTXZH的代码增加第五参数.zip (913.73 KB, 下载次数: 1)

2021-3-21 13:11 上传

点击文件名下载附件

老师：今天归纳和整理这一段您编写的有关排列组合的所有自定义函数，准备加载宏时，又有两个疑难需要向您求助：

一.给LTXPL和LTXZH两个自定义函数增加参数5-显示选择，规则如下：

  第五参数：显示选择
            1.可以调用单元格指定，也可以用数字指定。
            2.当第六参数指定为0或省略时，执行自定义函数原有的所有计算功能，用于组合显示符合条件的号码；
            3.当第六参数指定为1时，显示不同指定条件下可以组合的总注数；
            4.当第六参数指定为2时，显示指定条件下组合的和值；


二.想把模块4、5里的 两个内嵌的自定义函数ArrPC和HAOMAZUHE，前边加上Private使之变成私有的。如模块5里的第一行代码加上Private后，变成Private Function HAOMAZUHE(n, Optional 和值 = "", Optional m = "", Optional mode = 1, Optional 个数 = 0, Optional mode2 = 0)即可；
   但ArrPC内嵌了多个子程序，那么，模块4里的整个ArrPC代码，需要在哪几个地方前缀Private ，才能使之完全私有？

WYS67

yjh_27 发表于 2021-3-20 10:56
已更新。重新下载

恳请老师帮忙解决112楼的问题--达到以Arrpc、HAOMAZUHE为前缀Private （私有的）的共用函数，加上CTXPLS、ZDCTXZH，和LTXPL、LTXZH、ZDLTXZH五个自定义函数为分门别类的，囊括所有自然数排列组合的目标。谢谢！

玉阳山人

yjh_27 发表于 2019-2-26 19:48
参见附件。已改为排列。你可以给自定义函数重新命名。

拓展任意区间乐透型号码排列组合的功能.zip (216.53 KB, 下载次数: 8)

2021-12-16 01:35 上传

点击文件名下载附件

老师：上面附件乐透型号码排列、组合的自定义函数里，

     由于第一参数C1指定的是【乐透型彩票】n选m中号码总数n。假如C1指定为33，则代表需要排列组合的号码范围是01~33；假如C1指定为11，则代表需要排列组合的号码范围是01~11.等于默认所有最小数字都是从01开始。但是在实际应用时，经常会遇到从指定最小数字开始，到指定最大数字之间排列、组合的情况--如：从最小00~最大10这11个元素里，每次抽取m个的排列组合；或从最小21~最大33这13个元素里，每次抽取m个的排列组合......

   为了让自定义函数LTXPL和LTXZH具备更灵活、广泛的运算功能，需要将原第一参数C1【n选m中号码总数n】，拆分成指定最小数字（包括00）、最大数字（<=99）两个参数，使之可以对00~99范围内任意区间的元素，按照每次抽取m个进行排列组合。令：
C1代表最小数字（第一参数），
C2代表最大数字（第二参数），
C3代表每注排列组合的的元素个数m（第三参数），
mode=1为多列输出，mode<>1为单列输出（第四参数）；
ch=0，自动字符长度，ch<>0指定字符长度【指定为1时，显示单字节；指定为2时，显示双字节；指定为n时，即显示n字节（第五参数）.


附1.乐透型号码的排列--


'乐透型号码排列
Function LTXPL(C1, C2, Optional mode = 1, Optional ch = 2)
'C1取C2组合
'mode=1多列输出，mode<>1单列输出
'ch=0，自动字符长度，ch<>0指定字符长度
n = C1
m = C2
If Application.Version = "11.0" Then            '2003版本
    N3 = Application.Caller.Rows.Count
    M3 = 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, M3).Formula
        If Application.ThisCell.Offset(0, M3).Row = Columns.Count Then Exit Do
        M3 = M3 + 1
    Loop
End If
arr = ArrPC(n, m, 3, , 1)   '3 排列，1（或缺省） 组合
If ch = 0 Then fu = Application.Rept(0, Len(n)) Else fu = Application.Rept(0, Abs(ch))
If UBound(arr) > N3 Then kr = N3 Else kr = UBound(arr)
If UBound(arr, 2) > M3 Then kc = M3 Else kc = UBound(arr, 2)
If mode = 1 Then
    ReDim brr(1 To N3, 1 To M3)
    For i = 1 To kr
        For j = 1 To kc
            brr(i, j) = Format(arr(i, j), fu)
        Next
        For jj = j To M3
            brr(i, jj) = ""
        Next
    Next
    For ii = i To N3
        For j = 1 To M3
        brr(ii, j) = ""
    Next j, ii
Else
    ReDim brr(1 To N3, 1 To 1)
    For i = 1 To kr
        For j = 1 To UBound(arr, 2)
        brr(i, 1) = brr(i, 1) & Format(arr(i, j), fu)
    Next j, i
    For ii = i To N3
        brr(ii, 1) = ""
    Next
End If
LTXPL = brr
End Function


附2.乐透型号码的组合

Function LTXZH(C1, C2, Optional mode = 1, Optional ch = 2)
'C1取C2组合
'mode=1多列输出，mode<>1单列输出
ch=0，自动字符长度，ch<>0指定字符长度【指定为1时，显示单字节；指定为2时，显示双字节；指定为n时，即显示n字节.
n = C1
m = C2
If Application.Version = "11.0" Then            '2003版本
    N3 = Application.Caller.Rows.Count
    M3 = Application.Caller.Column.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, M3).Formula
        If Application.ThisCell.Offset(0, M3).Row = Columns.Count Then Exit Do
        M3 = M3 + 1
    Loop
End If
arr = ArrPC(n, m, , , 1)
If ch = 0 Then fu = Application.Rept(0, Len(n)) Else fu = Application.Rept(0, Abs(ch))
If UBound(arr) > N3 Then kr = N3 Else kr = UBound(arr)
If UBound(arr, 2) > M3 Then kc = M3 Else kc = UBound(arr, 2)
If mode = 1 Then
    ReDim brr(1 To N3, 1 To M3)
    For i = 1 To kr
        For j = 1 To kc
            brr(i, j) = Format(arr(i, j), fu)
        Next
        For jj = j To M3
            brr(i, jj) = ""
        Next
    Next
    For ii = i To N3
        For j = 1 To M3
        brr(ii, j) = ""
    Next j, ii
Else
    ReDim brr(1 To N3, 1 To 1)
    For i = 1 To kr
        For j = 1 To UBound(arr, 2)
        brr(i, 1) = brr(i, 1) & Format(arr(i, j), fu)
    Next j, i
    For ii = i To N3
        brr(ii, 1) = ""
    Next
End If
LTXZH = brr
End Function



恭请老师在上面自定义函数LTXPL和LTXZH的代码里，在全盘保留原代码运算功能的基础上，拆分原第一参数（指定号码总数n）为指定最小数字和指定最大数字两个参数。

谢谢！

玉阳山人

请老师们在全盘保留https://club.excelhome.net/forum ... 18&pid=10853526（115楼）LTXPL和LTXZH原代码运算功能的基础上，拆分原第一参数（指定号码总数n）为指定最小数字和指定最大数字两个参数。

玉阳山人

请老师们在全盘保留https://club.excelhome.net/forum ... 18&pid=10853526（115楼）LTXPL和LTXZH原代码运算功能的基础上，拆分原第一参数（指定号码总数n）为指定最小数字（>=00）和指定最大数字（<=99）两个参数。

yjh_27

玉阳山人 发表于 2021-12-16 02:43
老师：上面附件乐透型号码排列、组合的自定义函数里，

     由于第一参数C1指定的是【乐透型 ...

'乐透型号码排列
Function LTXPL(C0, C1, C2, Optional mode = 1, Optional ch = 2)

n = C1-C0+1

arr = ArrPC(n, m, 3,C0 , 1)   '3 排列，1（或缺省） 组合

玉阳山人

yjh_27 发表于 2021-12-17 10:36
'乐透型号码排列
Function LTXPL(C0, C1, C2, Optional mode = 1, Optional ch = 2)

经过验证，计算结果完全正确！谢谢老师！

玉阳山人

yjh_27 发表于 2021-12-17 10:36
'乐透型号码排列
Function LTXPL(C0, C1, C2, Optional mode = 1, Optional ch = 2)

老师：再请教您一个问题：如33选6的注数是：=COMBIN(33,6)=1107568注 ，但OFFICE excel2019 只有1048576行（即工作表最大行数没有组合的注数多），有没有办法自动扩展输出区域右边的对应列数显示多出的组合注数--
如原输入方法-  选定G5:G1000000，输入区域数组公式 {  =LTXZH(C0,C1,C2,2)或=LTXZH(1,33,6,2)  ，修改为------选定G5:H30000，输入区域数组公式 {  =LTXZH(C0,C1,C2,2)或=LTXZH(1,33,6,2)  ，H列则显示多出的组合号码？