通过变量调用数组，用字典可以实现吗？或用其他方法

ncow

代码大致如下，rng1(i,3)的值（可能是rd1或rd2或……），我需要通过获取该值，然后对对应的数组（rd1 对应数组 rng_rd1）进行赋值，想用字典，但以下用法不对，请问怎么修改或如何实施上述要求
[url=]咨询.rar[/url]
上传附件了，就是根据c列的值，分别对对应的数组赋值。最后赋值后数组的使用，我就自己可以处理了。

Public rng_rd1(1 To 10000, 1 To 16), rng_rd2(1 To 10000, 1 To 16), rng_rd3(1 To 10000, 1 To 16), rng_rd4(1 To 10000, 1 To 16), rng_rd5(1 To 10000, 1 To 16), rng_rd6(1 To 10000, 1 To 16), rng_rd7(1 To 10000, 1 To 16)
Public d1



Sub zj()

Set d1 = CreateObject("Scripting.Dictionary")
' d1后面的RD1是区分大小写的
d1("RD1") = rng_rd1
d1("RD2") = rng_rd2
d1("RD3") = rng_rd3
d1("RD4") = rng_rd4
d1("RD5") = rng_rd5
d1("RD6") = rng_rd6
d1("RD7") = rng_rd7

Sheets("经费").Select
m = ActiveSheet.[a1048576].End(xlUp).Row
rng1 = ActiveSheet.Range("a2:s" & m)
For I = 1 To UBound(rng1)

’rng1(I, 3)的值就是判断要对哪个数组赋值，下面循环就是通过循环判断该数组最后一条有记录行号，以便赋值在下一条开始，但d1(rng1(I, 3))(j, 1) 的用法不对
For j = 1 To 10000
If d1(rng1(I, 3))(j, 1) = "" Then
n = j
Exit For
End If
Next
n = 1
If rng1(I, 13) <> "" Then

'd1(rng1(I, 3))(n, 1)的用法不对，要怎么实现
d1(rng1(I, 3))(n, 1) = rng1(I, 19)
d1(rng1(I, 3))(n, 3) = rng1(I, 5)
d1(rng1(I, 3))(n, 4) = rng1(I, 6)
d1(rng1(I, 3))(n, 5) = rng1(I, 13)
d1(rng1(I, 3))(n, 6) = rng1(I, 13)
d1(rng1(I, 3))(n, 10) = rng1(I, 13)
End If

next
end sub

liulang0808

arr=d1(rng1(I, 3))
arr(1,1)= rng1(I, 19)
.....
d1(rng1(I, 3))=arr
看看是否可行

笨鸟飞不高

有问题，上传附件，说明要求，模拟结果！！

ncow

liulang0808 发表于 2022-12-10 15:54
arr=d1(rng1(I, 3))
arr(1,1)= rng1(I, 19)
.....

不行啊，d1(rng1(I, 3))返回的是空值，不是对应的数组

liulang0808

ncow 发表于 2022-12-10 16:06
不行啊，d1(rng1(I, 3))返回的是空值，不是对应的数组

Set d = CreateObject("Scripting.Dictionary")
    arr = Array(1, 1, 1)
    d(1) = arr
    brr = arr
    For j = 0 To UBound(brr)
        brr(j) = brr(j) + 1
    Next
    d(1) = brr

ncow

liulang0808 发表于 2022-12-10 16:21
Set d = CreateObject("Scripting.Dictionary")
    arr = Array(1, 1, 1)
    d(1) = arr

前面d1(rng1(i,3))返回是空，我知道原因了，d1里面的变量是区分大小写的。
但最后还是赋值的问题，赋值不成功，我上传附件了，帮忙看看。

ncow

liulang0808 发表于 2022-12-10 16:21
Set d = CreateObject("Scripting.Dictionary")
    arr = Array(1, 1, 1)
    d(1) = arr

用你这种方法，最后的d(1)=brr,也是看不到结果的。那你这个例子的话，我最终想要的是arr变为了与brr一样的值。最后的d(1)=brr，arr并没有变化

ncow

有人吗？能解决数组名用变量的问题吗。
测试了字典方法，用字典代替数组的方法，字典只能读取数组的数据，不能对数组写入数据

在XCVB

直接数组赋值就行。
代码如下：

1. 
   
2. Sub xs()
   
3. 
   
4. Dim arr(), RD1(), RD2(), RD3(), RD4(), RD5(), RD6(), RD7(), Drr
   
5. Dim E&, i&, v$, k&, j&, t
   
6. Dim x1&, x2&, x3&, x4&, x5&, x6&, x7&
   
7. 
   
8. t = Timer
   
9. E = Cells(Rows.Count, 3).End(3).Row
   
10. arr = Range("a2:s" & E).Value2
    
11. Drr = Array("RD1", "RD2", "RD3", "RD4", "RD5", "RD6", "RD7")
    
12. 
    
13. For i = 0 To UBound(Drr)
    
14.     k = Application.CountIf(Range("c2:c" & E), Drr(i))
    
15.         If Drr(i) = "RD1" Then ReDim RD1(1 To k, 1 To 16)
    
16.         If Drr(i) = "RD2" Then ReDim RD2(1 To k, 1 To 16)
    
17.         If Drr(i) = "RD3" Then ReDim RD3(1 To k, 1 To 16)
    
18.         If Drr(i) = "RD4" Then ReDim RD4(1 To k, 1 To 16)
    
19.         If Drr(i) = "RD5" Then ReDim RD5(1 To k, 1 To 16)
    
20.         If Drr(i) = "RD6" Then ReDim RD6(1 To k, 1 To 16)
    
21.         If Drr(i) = "RD7" Then ReDim RD7(1 To k, 1 To 16)
    
22. Next
    
23. 
    
24. For i = 1 To UBound(arr)
    
25.     v = arr(i, 3)
    
26.     If v = "RD1" Then
    
27.         x1 = x1 + 1
    
28.         For j = 1 To 16
    
29.             RD1(x1, j) = arr(i, j)
    
30.         Next
    
31.     ElseIf v = "RD2" Then
    
32.         x2 = x2 + 1
    
33.         For j = 1 To 16
    
34.             RD2(x2, j) = arr(i, j)
    
35.         Next
    
36.     ElseIf v = "RD3" Then
    
37.         x3 = x3 + 1
    
38.         For j = 1 To 16
    
39.             RD3(x3, j) = arr(i, j)
    
40.         Next
    
41.     ElseIf v = "RD4" Then
    
42.         x4 = x4 + 1
    
43.         For j = 1 To 16
    
44.             RD4(x4, j) = arr(i, j)
    
45.         Next
    
46.     ElseIf v = "RD5" Then
    
47.         x5 = x5 + 1
    
48.         For j = 1 To 16
    
49.             RD5(x5, j) = arr(i, j)
    
50.         Next
    
51.     ElseIf v = "RD6" Then
    
52.         x6 = x6 + 1
    
53.         For j = 1 To 16
    
54.             RD6(x6, j) = arr(i, j)
    
55.         Next
    
56.     ElseIf v = "RD7" Then
    
57.         x7 = x7 + 1
    
58.         For j = 1 To 16
    
59.             RD7(x7, j) = arr(i, j)
    
60.         Next
    
61.     End If
    
62.      
    
63. Next
    
64. MsgBox "ok:" & Timer - t
    
65. Stop
    
66. End Sub
    

复制代码

ncow

在XCVB 发表于 2022-12-12 16:31
直接数组赋值就行。
代码如下：

谢谢回复。
你的方法我也有试过，但存在问题，就是过程太大，无法执行。
这里上传的附件是我简化后的内容，所以没那么多内容，实际情况是有7个数组，每次对数组赋值大概有150条代码，如果写每个判断等于数组1的情况写150条，判读等于数组2的情况写150条 这里就7*150条代码了，而且我有个if elseif 的判断，那就7*150*2=2100条代码了，再加上一些其他的代码。最终的结果是过程太大无法运行。
如果能解决变量名调出数组的话，就可以用循环把代码写了，代码执行150+150就行了。