00000
00001
00002
.............
数字组合不限顺序,只要是ABCCC格式的即可,怎么用Excel快速筛选呢?
Excel怎样从数据集选r个数据排列组合列表(一)
工具/原料
Microsoft Office Excel 2007
Excel VBA
一、排列处理方法和步骤
1
首先打开Microsoft Office Excel 2007,新建文档并保存文件名《Excel怎样从数据集选r个数据排列组合列表 .xlsm》(演示文件,下面代码复制到能运行宏的工作簿都可以)如图。
请点击输入图片描述
然后按下快捷键ALT+F11打开VBA(宏)编辑界面,然后点菜单栏【插入】下拉中列表中点【模块(M)】如图。
请点击输入图片描述
然后插入了一个模块1,在代码框中复制如下代码:
Option Base 1
Sub 选数据排列()
'2020-7-10 21:41:46
Dim myr As Range, n As Long, r As Long, i As Long, mb(), m, k As Long, mc(), mk()
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long, i6 As Long, i7 As Long
Dim rr As Long, cc As Long, r1 As Long, c1 As Long
Set myr = Selection
n = myr.Count
If n <= 7 Then
r = Application.InputBox(Prompt:="输入选取个数r" & "(2≤r≤" & n & "):", Type:=2)
Else
r = Application.InputBox(Prompt:="输入选取个数r" & "(2≤r≤7):", Type:=2)
End If
If n < r Then Exit Sub
If r = 0 Or r = 1 Then Exit Sub
ReDim mb(n)
For i = 1 To n
mb(i) = myr.Cells(i).Value
Next i
Select Case r
Case Is = 2
ReDim mc(n * n)
For i1 = 1 To n
For i2 = 1 To n
m = Array(mb(i1), mb(i2))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i2
Next i1
Case Is = 3
ReDim mc(n * n * n)
For i1 = 1 To n
For i2 = 1 To n
For i3 = 1 To n
m = Array(mb(i1), mb(i2), mb(i3))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i3
Next i2
Next i1
Case Is = 4
ReDim mc(n * n * n * n)
For i1 = 1 To n
For i2 = 1 To n
For i3 = 1 To n
For i4 = 1 To n
m = Array(mb(i1), mb(i2), mb(i3), mb(i4))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i4
Next i3
Next i2
Next i1
Case Is = 5
ReDim mc(n * n * n * n * n)
For i1 = 1 To n
For i2 = 1 To n
For i3 = 1 To n
For i4 = 1 To n
For i5 = 1 To n
m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i5
Next i4
Next i3
Next i2
Next i1
Case Is = 6
ReDim mc(n * n * n * n * n * n)
For i1 = 1 To n
For i2 = 1 To n
For i3 = 1 To n
For i4 = 1 To n
For i5 = 1 To n
For i6 = 1 To n
m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5), mb(i6))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
Case Is = 7
ReDim mc(n * n * n * n * n * n * n)
For i1 = 1 To n
For i2 = 1 To n
For i3 = 1 To n
For i4 = 1 To n
For i5 = 1 To n
For i6 = 1 To n
For i7 = 1 To n
m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5), mb(i6), mb(i7))
DoEvents
If SZZF(m) = False Then
k = k + 1
mc(k) = Join(m, " ")
If k = 10000 Then GoTo my
End If
Next i7
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
End Select
my:
rr = Rows.Count
If k Mod rr = 0 Then
cc = Int(k / rr)
Else
cc = Int(k / rr) + 1
End If
ReDim mk(rr, cc)
r1 = 0
c1 = 1
For i = 1 To k
r1 = r1 + 1
mk(r1, c1) = mc(i)
If r1 = rr Then
r1 = 0
c1 = c1 + 1
End If
Next i
Set myr = Application.InputBox(Prompt:="输出排列数据的一个单元格!", Type:=8)
If k < rr Then
myr.Resize(k, cc) = mk
Else
Cells(1, myr.Column).Resize(rr, cc) = mk
End If
MsgBox "完成!"
End Sub
Function SZZF(m As Variant) As Boolean
'2020-7-8 22:40:24
Dim i As Long, mn As Variant
On Error Resume Next
With CreateObject("scripting.dictionary")
For i = 1 To UBound(m)
.Add m(i), i
Next i
mn = .Keys
End With
If UBound(m) = UBound(mn) + 1 Then
SZZF = False
Else
SZZF = True
End If
End Function
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
以上操作动态过程如下:
请点击输入图片描述
回到工作表窗口,首先选原数据表,然后运行【选数据排列】宏(菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选该宏名,执行),提示“输入选取个数r”,运行再提示"输出排列数据的一个单元格!",选好后输出结果,运行过程如下图。
如果数据大时运行时间长,到10000个组合输出结果,如果需要全部结果(如果数据量超大,一般电脑需要时间很长,甚至是无法处理完成。)把下面代码删除:
If k = 10000 Then GoTo my和my:
请点击输入图片描述
END
二、组合处理方法和步骤
选“Sheet2”工作表,右键,弹出快捷菜单,如下图。
请点击输入图片描述
打开VBA(宏)编辑界面,然后点菜单栏【插入】下拉中列表中点【模块(M)】如图。
请点击输入图片描述
然后插入了一个模块2,在代码框中复制如下代码:
由于经验字数据限制不能附上,再写一篇《EExcel怎样从数据集选r个数据排列组合列表(二)》也无法通过,只能图片和百度网盘链接下载复制。
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
请点击输入图片描述
代码截图和操作过程如下:
请点击输入图片描述
回到工作表窗口,首先选组合数据表,然后运行【选数据组合】宏(菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选该宏名,执行),提示“输入选取个数r”,运行再提示"输出组合数据的一个单元格!",选好后输出结果,运行过程如下图。
如果数据大时运行时间长,到10000个组合输出结果,如果需要全部结果(如果数据量超大,一般电脑需要时间很长,甚至是无法处理完成。)把下面代码删除:
If k = 10000 Then GoTo my和my:
请点击输入图片描述