[已解决]VBA先固定A列 再用5个数字组合输出B列

laoau138

VBA先固定A列   再用5个数字组合输出B列

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-3-24 16:27

1. Sub aaa()
   
2. Dim i&, j&, k&, l&, m&, s$, r&, arr(1 To 719, 1 To 2), n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To 5
   
5.   For j = 1 To 5
   
6.     If j <> i Then
   
7.       For k = 1 To 5
   
8.         If k <> i And k <> j Then
   
9.           For l = 1 To 5
   
10.             If l <> i And l <> j And l <> k Then
    
11.               For m = 1 To 5
    
12.                 If m <> i And m <> j And m <> k And m <> l Then
    
13.                   s = i + 4 & j + 4 & k + 4 & l + 4 & m + 4
    
14.                   For n = 1 To 5
    
15.                     r = r + 1
    
16.                     arr(r, 1) = n - 1
    
17.                     arr(r, 2) = Mid(s, n, 1)
    
18.                   Next n
    
19.                   r = r + 1
    
20.                   s = ""
    
21.                 End If
    
22.               Next m
    
23.             End If
    
24.           Next l
    
25.         End If
    
26.       Next k
    
27.     End If
    
28.   Next j
    
29. Next i
    
30. [a1].Resize(UBound(arr), 2) = arr
    
31. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim i&, j&, k&, l&, m&, s$, r&, arr(1 To 719, 1 To 2), n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To 5
   
5.   For j = 1 To 5
   
6.     If j <> i Then
   
7.       For k = 1 To 5
   
8.         If k <> i And k <> j Then
   
9.           For l = 1 To 5
   
10.             If l <> i And l <> j And l <> k Then
    
11.               For m = 1 To 5
    
12.                 If m <> i And m <> j And m <> k And m <> l Then
    
13.                   s = i + 4 & j + 4 & k + 4 & l + 4 & m + 4
    
14.                   For n = 1 To 5
    
15.                     r = r + 1
    
16.                     arr(r, 1) = n - 1
    
17.                     arr(r, 2) = Mid(s, n, 1)
    
18.                   Next n
    
19.                   r = r + 1
    
20.                   s = ""
    
21.                 End If
    
22.               Next m
    
23.             End If
    
24.           Next l
    
25.         End If
    
26.       Next k
    
27.     End If
    
28.   Next j
    
29. Next i
    
30. [a1].Resize(UBound(arr), 2) = arr
    
31. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-3-24 16:27

高手只用数组如何做

大灰狼1976

明天再看看，现在玩游戏时间