请各位高手：把下边VBA的3D组选源码改成直选源码

FJT1966 · 发表于 2012-5-14 06:18

请各位高手：把下边VBA的3D组选源码改成直码

例如组选： 123

直选： 123 132 213 231 312 321

3D组选源码：

Sub j组选号()

Dim arr() As String

r = 1

For i = 1 To Len([a1])

For j = 1 To Len([b1])

For k = 1 To Len([c1])

ReDim Preserve arr(r)

arr(r) = Mid([a1], i, 1) & Mid([b1], j, 1) & Mid([c1], k, 1)

r = r + 1

[a4].Resize(r, 1) = Application.Transpose(arr)

End Sub

先谢了 {:soso_e183:}

3D组选源码.rar (8.26 KB, 下载次数: 28)

FJT1966 · 发表于 2012-5-14 06:22

请各位高手：把下边VBA的3D组选源码改成直码

例如  组选： 123

   直选： 123  132 213 231 312 321

3D组选源码：

  Sub j组选号()

Dim arr() As String

r = 1

For i = 1 To Len([a1])

For j = 1 To Len([b1])

For k = 1 To Len([c1])

ReDim Preserve arr(r)

arr(r) = Mid([a1], i, 1) & Mid([b1], j, 1) & Mid([c1], k, 1)

r = r + 1

Next

Next

Next

[f1] = "共有" & r - 1 & "种组合"

[a4].Resize(r, 1) = Application.Transpose(arr)

End Sub

changxuegu · 发表于 2012-5-14 09:19

本帖最后由 changxuegu 于 2012-5-14 09:24 编辑

FJT1966 发表于 2012-5-14 06:22
请各位高手：把下边VBA的3D组选源码改成直码

Sub 直选()
Dim arr(1 To 3), brr(), m%, s$
s = Range("a1").Value
If Len(s) <> 3 Then Exit Sub
For i = 1 To 3
arr(i) = Mid(s, i, 1)
Next
For x = 1 To UBound(arr)
For y = 1 To UBound(arr)
For z = 1 To UBound(arr)
If arr(x) <> arr(y) And arr(y) <> arr(z) And arr(x) <> arr(z) Then
ReDim Preserve brr(0 To m)
brr(m) = arr(x) & arr(y) & arr(z)
m = m + 1
End If
Next
Next
Next
Range("b5").Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
MsgBox "共有" & UBound(brr) + 1 & "种组合"
End Sub

复制代码

changxuegu · 发表于 2012-5-14 13:09

FJT1966 发表于 2012-5-14 12:47
二楼 changxuegu 您好，谢谢你的源码
可能我没说明白，就是在A1 B1 CI 三个单元格里，分别有不同位数的数 ...

能手工模拟一下结果吗？

FJT1966 · 发表于 2012-5-14 12:47

二楼 changxuegu 您好，谢谢你的源码
可能我没说明白，就是在A1  B1 CI 三个单元格里，分别有不同位数的数据，
例如 A1:  345
      B1:  0687
      CI :  35874
通过运行VBA程序,在B5列里显示出所有以（A1，B1 C1) 组成的直选号码，并在D1里显示注数。
希望能再帮改下源码
万分感谢！！

hlly888 · 发表于 2012-5-14 14:13

本帖最后由 hlly888 于 2012-5-14 14:44 编辑

3D选hao.zip (9.45 KB, 下载次数: 69)

FJT1966 · 发表于 2012-5-14 16:40

请各位高手：
㈠把2楼的VBA直选源码改成组选源码。
㈡ A1 B1 C 1三个单元格里数据输入的格式不要改

万分感谢
请问，谁能把三楼源码变成Exce格式文件发上来吗？
我没看明白源码先谢了

hlly888 · 发表于 2012-5-14 17:09

FJT1966 发表于 2012-5-14 16:40
请各位高手：
㈠把2楼的VBA直选源码改成组选源码。
㈡ A1 B1 C 1三个单元格里数据输入的格式不要改

什么是“直选，组选”？
在附件里模拟个结果。

hlly888 · 发表于 2012-5-14 17:46

本帖最后由 hlly888 于 2012-5-14 19:30 编辑

FJT1966 发表于 2012-5-14 16:40
请各位高手：
㈠把2楼的VBA直选源码改成组选源码。
㈡ A1 B1 C 1三个单元格里数据输入的格式不要改

数据格式你可以随意改。如果有012的情况时，不用文本格式，第一个0不会显示。
模拟结果，要比文字说明更容易理解。
三楼源码自己可以复制到excel里。

Wbn6636 · 发表于 2012-5-14 20:57

采用Split函数，会更简捷些。

		自动登录	找回密码
密码			免费注册

[求助] 请各位高手：把下边VBA的3D组选源码改成直选源码