[已解决]求vba

zhaongxa

组合数.rar (5.86 KB, 下载次数: 7)

2013-11-6 13:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2013-11-7 13:48

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, arr1, i&, j&, k&, l&, m&
   
3. Columns(1).ClearContents
   
4. arr = Cells(2, 2).CurrentRegion
   
5. ReDim arr1(1 To UBound(arr, 2) * 64)
   
6. For j = 1 To UBound(arr, 2)
   
7.   For i = Mid(arr(1, j), 1, 1) To 9 Step 3
   
8.     For k = Mid(arr(1, j), 2, 1) To 9 Step 3
   
9.       For l = Mid(arr(1, j), 3, 1) To 9 Step 3
   
10.         m = m + 1
    
11.         arr1(m) = i & k & l
    
12.       Next l
    
13.     Next k
    
14.   Next i
    
15. Next j
    
16. [a1].Resize(UBound(arr1)) = Application.Transpose(arr1)
    
17. End Sub

复制代码

跳转到最佳答案楼层

zhaongxa

求助求助求助

fffox

问题都没有说清楚，叫别人怎么解答啊

大灰狼1976

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, arr1, i&, j&, k&, l&, m&
   
3. Columns(1).ClearContents
   
4. arr = Cells(2, 2).CurrentRegion
   
5. ReDim arr1(1 To UBound(arr, 2) * 64)
   
6. For j = 1 To UBound(arr, 2)
   
7.   For i = Mid(arr(1, j), 1, 1) To 9 Step 3
   
8.     For k = Mid(arr(1, j), 2, 1) To 9 Step 3
   
9.       For l = Mid(arr(1, j), 3, 1) To 9 Step 3
   
10.         m = m + 1
    
11.         arr1(m) = i & k & l
    
12.       Next l
    
13.     Next k
    
14.   Next i
    
15. Next j
    
16. [a1].Resize(UBound(arr1)) = Application.Transpose(arr1)
    
17. End Sub

复制代码