下标越界，请大神帮忙修改代码

假绅士

附件中有一串代码，是用来将以日期命名的工作表中的数据导入到“流动资产”和“流动负债”两张表中的，但是现在出现一个问题，每当代码Do While arr(n, 1) <> ""运行到表格最后一行，就出现下标越界的提示的，想让大神们帮忙看看怎么解决。以下是代码原文，是咱们论坛中的大神帮我写的。不过由于我们附表有所变动，所以这个代码运行不了了。想麻烦大神们帮忙改改。
整张表格的设计思路如下：
1、点击“提取文件”按钮，代码自动将文件所在文件夹内的指定文件导入到工作簿内，工作表按照日期顺序自动排列
2、点击“提出数据”按钮，代码自动将导入工作表的指定数据导入到“流动资产方”和“流动负责方”带有编码且对应日期的单元格内
3、点击“数据计算”按钮，代码自动按照指定公式将带有编码单元格内的数据计算并填充到对应单元格内
请大神们改完下面这段代码后可以帮我看看其他的代码有没有什么需要改的，本人小白，懂的不多，感谢指点！！！

1. Sub 提出数据()
   
2.     Dim d, k, sht, n$, br, arr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Sheets("流动资产方").Activate
   
5.     For Each k In Range(Range("a3"), Range("a33")).Cells
   
6.         Set d(k.Text) = CreateObject("scripting.dictionary")
   
7.            With Sheets(k.Text)
   
8.             arr = .Range(.Range("a1"), .Range("a6").End(xlDown).Offset(, 9))
   
9.            End With
   
10.         n = 10
    
11.         Do While arr(n, 1) <> ""
    
12.             d(k.Text)(arr(n, 1)) = arr(n, 7) & arr(n, 8)
    
13.             n = n + 1
    
14.         Loop
    
15.     Next
    
16.     For Each sht In Array(Sheets("流动资产方"), Sheets("流动负债方"))
    
17.         If sht.Name = "流动资产方" Then br = Array(2, 4, 7, 8, 9, 14) _
    
18.         Else br = Array(2, 4, 5, 6)
    
19.         Set Rng = sht.Range(sht.Range("a1"), sht.Range("a3:a33").Offset(, 16))
    
20.         For I = 3 To Rng.Rows.Count
    
21.             For j = 0 To UBound(br)
    
22.                 With Rng
    
23.                 dt = Format(Rng(I, 1))
    
24.                 .Cells(I, br(j)) = d(dt)(.Cells(2, br(j)).Text)
    
25.                 End With
    
26.             Next
    
27.         Next
    
28.     Next
    
29. End Sub

复制代码

假绅士

有没有大神给指点指点

假绅士

@望帝春心

苏子龙

Sub 提出数据()
    Dim d, k, sht, n&, br, arr
    Set d = CreateObject("scripting.dictionary")
    Sheets("流动资产方").Activate
    For Each k In Range(Range("a3"), Range("a33")).Cells
        Set d(k.Text) = CreateObject("scripting.dictionary")
           With Sheets(k.Text)
            arr = .Range(.Range("a1"), .Range("a6").End(xlDown).Offset(, 9))
           End With
'        n = 10
'        Do While arr(n, 1) <> ""
'            d(k.Text)(arr(n, 1)) = arr(n, 7) & arr(n, 8)
'            n = n + 1
'        Loop
        For n = 10 To UBound(arr)
            d(k.Text)(arr(n, 1)) = arr(n, 7) & arr(n, 8)
        Next

    Next
    For Each sht In Array(Sheets("流动资产方"), Sheets("流动负债方"))
        If sht.Name = "流动资产方" Then br = Array(2, 4, 7, 8, 9, 14) _
        Else br = Array(2, 4, 5, 6)
        Set Rng = sht.Range(sht.Range("a1"), sht.Range("a3:a33").Offset(, 16))
        For I = 3 To Rng.Rows.Count
            For j = 0 To UBound(br)
                With Rng
                dt = Format(Rng(I, 1))
                .Cells(I, br(j)) = d(dt)(.Cells(2, br(j)).Text)
                End With
            Next
        Next
    Next
End Sub

假绅士

苏子龙 发表于 2018-1-3 15:48
Sub 提出数据()
    Dim d, k, sht, n&, br, arr
    Set d = CreateObject("scripting.dictionary")

正解，谢谢您，能帮忙解释一下怎么回事么？

苏子龙

假绅士 发表于 2018-1-3 16:28
正解，谢谢您，能帮忙解释一下怎么回事么？

n超数组范围了

假绅士

苏子龙 发表于 2018-1-3 16:34
n超数组范围了

谢谢，明白了

falcon9999

学习了。