12
返回列表 上一主題 發帖

[發問] 陣列大小如何以變數替代

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-3-7 22:03 | 只看該作者

[發問] 陣列大小如何以變數替代

[版主管理留言]
  • GBKEE(2019/3/8 10:56): 看你的程式碼沒問題,可附檔讓大家看看

我想在儲存格輸入一個數值，來決定 Br 陣列的大小，然後把陣列的元素存入字典裡，但是出現了"陣列索引超出範圍"的提示，請問各位大大是哪裡出錯了?
Dim Br() As String,k%
k = [U1].Value
Set d = CreateObject("Scripting.Dictionary")
For Each A In Range([A9], [A6000].End(xlUp))
   ReDim Preserve Br(k)
    For j = 1 To k
      Br(j) = A.Offset(, j + 159).Value
    Next j
    d(A & "") = Br(k)
Next
收藏 分享
Jess

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2019-3-9 09:08 | 只看該作者
回復 5# jesscc

我在想是不是轉資料的部分有誤

自行偵錯看看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Br() As String, k%, D As Object, A As Range, J As Integer
  4.     On Error GoTo RR   '程式有錯誤時到指定行號(RR)
  5.     k = [U1].Value
  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     For Each A In Range([A9], [A6000].End(xlUp))
  8.         ReDim Preserve Br(k)
  9.         For J = 1 To k
  10.             Br(J) = A.Offset(, J + 159).Value
  11.         Next J
  12.         D(A & "") = Br(k)
  13.     Next
  14.     Exit Sub
  15. RR:
  16.    Application.VBE.Windows("區域變數").Visible = True
  17.    
  18.    Stop
  19.    '程式暫停 查看所有變數看看錯誤在哪裡
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jackyq

帖子
323 
主題
6 
精華
0 
積分
313 
點名
0  
作業系統
xp 
軟體版本
2k 
閱讀權限
20 
性別
男 
註冊時間
2015-6-24 
最後登錄
2025-5-3 
14#
發表於 2019-3-8 23:17 | 只看該作者
本帖最後由 jackyq 於 2019-3-8 23:19 編輯

(1)
k=0 時
會變成 Redim Br(1 To 0)  '--> VBA 沒有辦法配置這種陣列
IF K>=1 Then ..... End if 可以防止 執行到 Redim Br(1 To 0)  

(2)
儘量不要去使用 Option Base 1 這種東西

最好直接寫成 Redim Br(1 To K)

TOP

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
13#
發表於 2019-3-8 22:54 | 只看該作者
If k >= 1 Then
'        For Each a In .Range(.[A9], .[A6000].End(xlUp))
'            ReDim Br(k)
'
'            For j = 1 To k
'            Br(j) = a.Offset(, j + 159).Value
'            Next j
'            d1(a & "") = Br
'        Next
'    End If

不好意思，j大。測試已OK，是我少修改了一個地方。不過我還是不太明白為什麼加了這段
If k >= 1 Then
.
.

End If
就沒問題了
Jess

TOP

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
12#
發表於 2019-3-8 22:34 | 只看該作者
' 有可能你的 k值 出現
jackyq 發表於 2019-3-8 21:54

雖然沒有出現偵錯，但是查詢結果變成這樣
Jess

TOP

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
11#
發表於 2019-3-8 22:10 | 只看該作者
我修改程式時一開始就把U1的值指定給k了-->  k = [U1].Value，而U1的值確定是大於等於1的。(實際工作時U1的輸入值必定是大於等於24)
Jess

TOP

jackyq

帖子
323 
主題
6 
精華
0 
積分
313 
點名
0  
作業系統
xp 
軟體版本
2k 
閱讀權限
20 
性別
男 
註冊時間
2015-6-24 
最後登錄
2025-5-3 
10#
發表於 2019-3-8 21:54 | 只看該作者
本帖最後由 jackyq 於 2019-3-8 22:03 編輯

' 有可能你的 k值 出現 <=0
' 你可以試試下面

Option Base 1  

Sub QX9650_____()

Dim a()


k = 10
ReDim a(k)

k = 1
ReDim a(k)

k = 0
ReDim a(k)  '你把陣列下限設為 1 , 結果變成 Redim  a(1 to 0)

End Sub




'    If k >= 1 Then
'        For Each a In .Range(.[A9], .[A6000].End(xlUp))
'            ReDim Br(k)
'
'            For j = 1 To k
'            Br(j) = a.Offset(, j + 159).Value
'            Next j
'            d1(a & "") = Br
'        Next
'    End If

TOP

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
9#
發表於 2019-3-8 21:40 | 只看該作者
回復 8# jackyq
原始程式執行沒有問題，我只是想把原本的Br陣列(大小固定為24個元素)改成可依儲存格輸入的數值隨意變動大小
Jess

TOP

jackyq

帖子
323 
主題
6 
精華
0 
積分
313 
點名
0  
作業系統
xp 
軟體版本
2k 
閱讀權限
20 
性別
男 
註冊時間
2015-6-24 
最後登錄
2025-5-3 
8#
發表於 2019-3-8 20:50 | 只看該作者
不是只有 Array
以下也會產生 "陣列索引超出範圍"

Workbooks("不存在的wb").Activate
Sheets("不存在的ws").Select

TOP

jesscc

帖子
162 
主題
44 
精華
0 
積分
244 
點名
0  
作業系統
windows 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-4-4 
最後登錄
2022-10-3 

論壇贊助勳章
7#
發表於 2019-3-8 20:11 | 只看該作者
貼出原始程式碼，活頁簿及工作表名稱有略做修改
  1. Option Base 1
  2. 開啟另一個非工作中活頁簿WK(以下省略).
  3. .
  4. .
  5. .

  7. With Sheets("Inventory Report")
  8. IRM1 = .[C4]
  9. IRM2 = .[C5]
  10. Set d = CreateObject("Scripting.Dictionary")
  11. Set d1 = CreateObject("Scripting.Dictionary")

  13. For Each A In .Range(.[A9], .[A6000].End(xlUp))

  15. Dim Ar(13), Br(24)
  16.     For i = 1 To 13
  17.     Ar(i) = A.Offset(, i).Value
  18.     Next i
  19.     d(A & "") = Ar
  20.    
  21.     For j = 1 To 24
  22.     Br(j) = A.Offset(, j + 159).Value
  23.     Next j
  24.     d1(A & "") = Br

  26. Next
  27. End With

  29. Workbooks("L.xlsm").Activate
  30. With Sheets("A INV Report")
  31. .[E10,G10,G11,G12:AR3000].ClearContents
  32. .[G10] = IRM1
  33. .[G11] = IRM2
  34. If .[H9] Like "* A *" Then: .[E10] = "A"
  35. If .[H9] Like "* B *" Then: .[E10] = "B"

  37.     For Each A In .Range(.[F12], .[F10000].End(xlUp))
  38.       If d.exists(A & "") Then
  39.       A.Offset(, 1).Resize(, 13) = d(A & "")
  40.       End If
  41.       If d1.exists(A & "") Then
  42.       A.Offset(, 15).Resize(, 24) = d1(A & "")
  43.       Else: A.Offset(, 1).Value = "查無此 PN"
  44.       End If
  45.     Next
  46. End With

  48. Erase Ar,Br
  49. Set d = Nothing
  50. Set d1 = Nothing
  51. End Sub
複製代碼
Jess

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
12
返回列表 上一主題