[已解决]怎样由一个一维数组生成二维数组？

gwfzh

怎样由一个一维数组生成二维数组？

各位老师：

         [a2:l3]是由子-亥文本转换成对应数据，[n1:n11]是抽样得到的一组实际数据，现在的问题是：

         1、现在怎样由1－12数据即m＝12个元素中任取n=2个进行组合？

         2、怎样将上述所得66个组合数据生成6行、11列的二维数组arr()（如[q1:aa7]区域）？

         3、怎样将ar=[n1:n11]的每行抽样数据数据与上述二维数组arr()比较，判断ar中的每行抽样数据在二维数组arr()中行号与列号如[o4:p11]区域？

        上述程序、特别是2-3步骤的代码该怎样写，请各位老师帮忙了！谢谢！！！ 怎样由一个一维数组生成二维数组？.rar (30.42 KB, 下载次数: 6)

2015-1-4 13:41 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-1-4 15:41

不要随机啊，那简单许多：

1. Sub tt()
   
2.    Dim brr(1 To 6, 1 To 11)      '把组合放入6*11的数组，并标记每种组合的位置
   
3.    Set d = CreateObject("scripting.dictionary")
   
4.    For i = 1 To 11
   
5.         For j = i + 1 To 12
   
6.             k = k + 1      '顺序数
   
7.             p = k Mod 6: If p = 0 Then p = 6     '根据顺序数计算二维数组中的行
   
8.             q = Int((k - 0.1) / 6) + 1         '根据顺序数计算二维数组中的列
   
9.             brr(p, q) = Format(i, "00") & " " & Format(j, "00")      '组合
   
10.             d(brr(p, q)) = "第" & q & "列" & ",第" & p & "行"  '标记行列
    
11.         Next
    
12.     Next
    
13.     [q2].Resize(6, 11) = brr
    
14.    
    
15.     Range("o1:p" & [n65536].End(3).Row).ClearContents
    
16.     crr = Range("n1:p" & [n65536].End(3).Row)      '读入抽样数据
    
17.     For i = 1 To UBound(crr)
    
18.         x = crr(i, 1)
    
19.         If d.exists(x) Then           '读入组合的位置
    
20.             crr(i, 2) = Split(d(x), ",")(0)
    
21.             crr(i, 3) = Split(d(x), ",")(1)
    
22.         End If
    
23.     Next
    
24.     Range("n1:p" & [n65536].End(3).Row) = crr     '结果显示
    
25. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.    Dim arr(1 To 66, 1 To 2)    '记录12选2的全组合
   
3.    For i = 1 To 11
   
4.         For j = i + 1 To 12
   
5.             k = k + 1
   
6.             arr(k, 1) = Format(i, "00") & " " & Format(j, "00")       '组合
   
7.             arr(k, 2) = Rnd          '辅助列，随机
   
8.         Next
   
9.     Next
   
10.     For i = 1 To UBound(arr) - 1         '把组合按辅助列排序，达到随机的效果
    
11.         For j = i + 1 To UBound(arr)
    
12.             If arr(i, 2) > arr(j, 2) Then
    
13.                 p1 = arr(i, 1): p2 = arr(i, 2)
    
14.                 arr(i, 1) = arr(j, 1): arr(i, 2) = arr(j, 2)
    
15.                 arr(j, 1) = p1: arr(j, 2) = p2
    
16.             End If
    
17.         Next
    
18.     Next
    
19.    
    
20.     Dim brr(1 To 6, 1 To 11)      '把组合放入6*11的数组，并标记每种组合的位置
    
21.     Set d = CreateObject("scripting.dictionary")
    
22.     k = 0
    
23.     For i = 1 To 6
    
24.         For j = 1 To 11
    
25.             k = k + 1
    
26.             brr(i, j) = arr(k, 1)
    
27.             d(brr(i, j)) = "第" & j & "列" & ",第" & i & "行"
    
28.         Next
    
29.     Next
    
30.     [q2].Resize(6, 11) = brr
    
31.    
    
32.     Range("o1:p" & [n65536].End(3).Row).ClearContents
    
33.     crr = Range("n1:p" & [n65536].End(3).Row)      '读入抽样数据
    
34.     For i = 1 To UBound(crr)
    
35.         x = crr(i, 1)
    
36.         If d.exists(x) Then           '读入组合的位置
    
37.             crr(i, 2) = Split(d(x), ",")(0)
    
38.             crr(i, 3) = Split(d(x), ",")(1)
    
39.         End If
    
40.     Next
    
41.     Range("n1:p" & [n65536].End(3).Row) = crr     '结果显示
    
42. End Sub
    

复制代码

grf1973

请看附件。

grf1973

改进一下：

1. Sub tt()
   
2.    Dim arr(1 To 66, 1 To 1)    '记录12选2的全组合
   
3.    For i = 1 To 11
   
4.         For j = i + 1 To 12
   
5.             k = k + 1
   
6.             arr(k, 1) = Format(i, "00") & " " & Format(j, "00")       '组合
   
7.         Next
   
8.     Next
   
9.    
   
10.     p = 66
    
11.     Dim brr(1 To 6, 1 To 11)      '把组合随机放入6*11的数组，并标记每种组合的位置
    
12.     Set d = CreateObject("scripting.dictionary")
    
13.     For i = 1 To 6
    
14.         For j = 1 To 11
    
15.             k = Int(Rnd() * p + 1)    '随机数
    
16.             brr(i, j) = arr(k, 1)        '选中随机数对应的组合放入二维数组
    
17.             d(brr(i, j)) = "第" & j & "列" & ",第" & i & "行"   '标记行列
    
18.             arr(k, 1) = arr(p, 1)        '最末组合放入已选过的位置
    
19.             p = p - 1        '最末指针-1
    
20.         Next
    
21.     Next
    
22.     [q2].Resize(6, 11) = brr
    
23.    
    
24.     Range("o1:p" & [n65536].End(3).Row).ClearContents
    
25.     crr = Range("n1:p" & [n65536].End(3).Row)      '读入抽样数据
    
26.     For i = 1 To UBound(crr)
    
27.         x = crr(i, 1)
    
28.         If d.exists(x) Then           '读入组合的位置
    
29.             crr(i, 2) = Split(d(x), ",")(0)
    
30.             crr(i, 3) = Split(d(x), ",")(1)
    
31.         End If
    
32.     Next
    
33.     Range("n1:p" & [n65536].End(3).Row) = crr     '结果显示
    
34. End Sub

复制代码

gwfzh

grf1973 发表于 2015-1-4 15:03
改进一下：

谢谢老师的帮助！但这里我不需要“ '把组合按辅助列排序，达到随机的效果”，组合矩阵第一位、第二位只是按1-12原始数据自然数顺序排列，如[q1:aa7]区域，不打乱顺序，然后再找出[n1:n11]区域的数据，如“结果”中的[q1:aa7]和[o4:p11]区域，因为矩阵数组[q1:aa7]的元素顺序是固定的，这样每次的抽样数据好比对

grf1973

不要随机啊，那简单许多：

1. Sub tt()
   
2.    Dim brr(1 To 6, 1 To 11)      '把组合放入6*11的数组，并标记每种组合的位置
   
3.    Set d = CreateObject("scripting.dictionary")
   
4.    For i = 1 To 11
   
5.         For j = i + 1 To 12
   
6.             k = k + 1      '顺序数
   
7.             p = k Mod 6: If p = 0 Then p = 6     '根据顺序数计算二维数组中的行
   
8.             q = Int((k - 0.1) / 6) + 1         '根据顺序数计算二维数组中的列
   
9.             brr(p, q) = Format(i, "00") & " " & Format(j, "00")      '组合
   
10.             d(brr(p, q)) = "第" & q & "列" & ",第" & p & "行"  '标记行列
    
11.         Next
    
12.     Next
    
13.     [q2].Resize(6, 11) = brr
    
14.    
    
15.     Range("o1:p" & [n65536].End(3).Row).ClearContents
    
16.     crr = Range("n1:p" & [n65536].End(3).Row)      '读入抽样数据
    
17.     For i = 1 To UBound(crr)
    
18.         x = crr(i, 1)
    
19.         If d.exists(x) Then           '读入组合的位置
    
20.             crr(i, 2) = Split(d(x), ",")(0)
    
21.             crr(i, 3) = Split(d(x), ",")(1)
    
22.         End If
    
23.     Next
    
24.     Range("n1:p" & [n65536].End(3).Row) = crr     '结果显示
    
25. End Sub

复制代码

gwfzh

grf1973 发表于 2015-1-4 15:41
不要随机啊，那简单许多：

谢谢“grf1973”老师，在你的帮助，该问题顺利解决了！