字典使用問題
工作是這樣的用工作表2的"PN"欄位去跟工作表1的"PN"欄位比對，如果有比對到相同的，就把那個PN從C欄到L欄的數值傳回到工作表2相同PN的對應位置，程式一直沒辦法正確執行，不過實在找不到哪裡有問題，能幫忙看一下問題出在哪嗎?
[attach]29562[/attach] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105617&ptid=21215]1#[/url] [i]jesscc[/i] [/b]
程式碼修改如下：[code]Option Base 1
Sub test()
With Sheets("工作表1")
Set D = CreateObject("Scripting.Dictionary")
For Each B In .Range(.[B6], .[B100].End(xlUp))
Dim Ar(10)
For p = 1 To 10
Ar(p) = B.Offset(, p).Value
Next p
D(B & "") = Ar
Next
End With
With Sheets("工作表2")
.[F7:O1000].ClearContents
For Each E In .Range(.[E7], .[E100].End(xlUp))
If D.EXISTS(E & "") Then
E.Offset(, 1).Resize(, 10) = D(E & "")
Else: E.Offset(, 1) = "查無此 PN"
End If
Next
End With
End Sub
[/code] 請問K大，我之前其他的工作，字典程式開頭都沒加這段 "Option Base 1"， 將陣列索引值下限設為1，但都可以正常執行，為什麼在這裡沒有加就會執行錯誤? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105624&ptid=21215]3#[/url] [i]jesscc[/i] [/b]
With Sheets("工作表2")
.[F7:O1000].ClearContents
For Each [b][color=Green][size=5]E[/size][/color][/b] In .Range(.[E7], .[E100].End(xlUp))
If D.EXISTS([b][color=Blue][size=5]B[/size][/color][/b] & "") Then
E.Offset(, 1).Resize(, 10) = D([b][color=Blue][size=5]B[/size][/color][/b] & "")
Else: E.Offset(, 1) = "查無此 PN"
End If
Next
End With [color=Blue][b]B[/b][/color] change as [color=Green][b]E[/b][/color] [quote]B change as E
[size=2][color=#999999]jackyq 發表於 2018-10-21 07:38[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105628&ptid=21215][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]
已改，可正常執行，但我的疑問是如果把第一段這句 "Option Base 1" 拿掉，整個資料傳回結果會向右偏一欄，我只知道這是陣列索引下限值的問題，如果在不設定下限值的情形下，要如何改寫原來的陣列排列? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105629&ptid=21215]6#[/url] [i]jesscc[/i] [/b]
With Sheets("工作表1")
Set D = CreateObject("Scripting.Dictionary")
For Each B In .Range(.[B6], .[B100].End(xlUp))
[size=4][color=DarkOrchid][b]Dim Ar(10)[/b][/color][/size]
For p = 1 To 10
Ar(p) = B.Offset(, p).Value
Next p
D(B & "") = Ar
Next
End With
[b][color=DarkOrchid]Dim Ar(10)[/color][/b] change as[b][color=DarkOrchid] Dim Ar(1 To 10)[/color][/b] Sub Test2()
Dim Arr, Brr, xD, i&, j%, U&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([工作表1!L6], [工作表1!B65536].End(xlUp))
For i = 1 To UBound(Arr): xD(Arr(i, 1)) = i: Next
[工作表2!F7:O2000].ClearContents
Brr = Range([工作表2!O7], [工作表2!E65536].End(xlUp))
For i = 1 To UBound(Brr)
U = xD(Brr(i, 1)): Brr(i, 2) = "查無此PN": If U = 0 Then GoTo 101
For j = 2 To 11: Brr(i, j) = Arr(U, j): Next
101: Next i
[工作表2!E7:O7].Resize(UBound(Brr)) = Brr
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105624&ptid=21215]3#[/url] [i]jesscc[/i] [/b]
若沒有宣告Option Base 1的話，則底下的Dim Ar(10)會包含Ar(0)、Ar(1)、Ar(2)、Ar(3)...、Ar(10)共有11個陣列元素。
若宣告Option Base 1的話，則Ar(10)陣列只包含Ar(1)、Ar(2)、Ar(3)...、Ar(10)，10個陣列元素。
若Option Base 1 拿掉的話，整個資料傳回結果會向右偏一欄就是這個道理。 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=105645&ptid=21215]9#[/url] [i]Kubi[/i] [/b]
謝謝K大，了解了。 謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
資料表:
[attach]36368[/attach]
結果表執行前:
[attach]36369[/attach]
執行結果:
[attach]36370[/attach]
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&, j&, Q&
[color=SeaGreen]'↑宣告變數[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
With 工作表1: Arr = Range(.[L6], .[B65536].End(3)): End With
[color=SeaGreen]'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中[/color]
For i = 1 To UBound(Arr): Y(Arr(i, 1)) = i: Next
[color=SeaGreen]'↑令Arr陣列的迴圈列第1欄值當key,item是i迴圈變數(以字典紀錄鍵值與列號)[/color]
With 工作表2
.[F7].Resize(1000, 10).ClearContents
[color=SeaGreen] '↑令結果表清除儲存格舊結果[/color]
Brr = Range(.[E7], .[E65536].End(3))
[color=SeaGreen] '↑令Arr變數是 二維陣列,以儲存格值帶入陣列中[/color]
End With
ReDim Crr(1 To UBound(Brr), 1 To 10)
[color=SeaGreen]'↑令宣告Crr變數是 二維空陣列,縱向範圍同Brr,橫向範圍索引號1~10[/color]
For i = 1 To UBound(Brr)
[color=SeaGreen]'↑設順迴圈[/color]
Q = Y(Brr(i, 1))
[color=SeaGreen] '↑令Q變數帶出Brr陣列1欄關鍵字在Y字典裡紀錄的Arr陣列列號[/color]
If Q = 0 Then Crr(i, 1) = "查無此PN": GoTo i01
[color=SeaGreen] '↑如果Q變數是 0,代表Arr陣列裡無此鍵,只在註記欄位做註記[/color]
For j = 1 To 10: Crr(i, j) = Arr(Q, j + 1): Next
[color=SeaGreen] '↑設迴圈將Arr陣列值帶入Crr陣列[/color]
i01: Next
[工作表2!F7].Resize(UBound(Crr), 10) = Crr
[color=SeaGreen]'↑令Crr陣列值從[工作表2!F7]開始,倒入儲存格中[/color]
Set Y = Nothing: Erase Arr, Brr, Crr
[color=SeaGreen]'↑令釋放變數[/color]
End Sub
頁:
[1]