Board logo

標題: [發問] 字典使用問題 [打印本頁]
作者: jesscc    時間: 2018-10-20 16:47     標題: 字典使用問題

工作是這樣的
用工作表2的"PN"欄位去跟工作表1的"PN"欄位比對，如果有比對到相同的，就把那個PN從C欄到L欄的數值傳回到工作表2相同PN的對應位置，程式一直沒辦法正確執行，不過實在找不到哪裡有問題，能幫忙看一下問題出在哪嗎?
[attach]29562[/attach]
作者: Kubi    時間: 2018-10-20 21:25

回復 1# jesscc
程式碼修改如下：
  1. Option Base 1
  2. Sub test()

  4. With Sheets("工作表1")
  5. Set D = CreateObject("Scripting.Dictionary")

  7. For Each B In .Range(.[B6], .[B100].End(xlUp))
  8. Dim Ar(10)
  9.     For p = 1 To 10
  10.     Ar(p) = B.Offset(, p).Value
  11.     Next p
  12.     D(B & "") = Ar
  13. Next
  14. End With


  17. With Sheets("工作表2")
  18. .[F7:O1000].ClearContents
  19.     For Each E In .Range(.[E7], .[E100].End(xlUp))
  20.       If D.EXISTS(E & "") Then
  21.       E.Offset(, 1).Resize(, 10) = D(E & "")
  22.       Else: E.Offset(, 1) = "查無此 PN"
  23.       End If
  24.     Next
  25. End With


  28. End Sub
複製代碼
作者: jesscc    時間: 2018-10-20 23:25

請問K大，我之前其他的工作，字典程式開頭都沒加這段 "Option Base 1"， 將陣列索引值下限設為1，但都可以正常執行，為什麼在這裡沒有加就會執行錯誤?
作者: jackyq    時間: 2018-10-21 07:34

回復 3# jesscc


    With Sheets("工作表2")
.[F7:O1000].ClearContents
    For Each E In .Range(.[E7], .[E100].End(xlUp))
      If D.EXISTS(B & "") Then
      E.Offset(, 1).Resize(, 10) = D(B & "")
      Else: E.Offset(, 1) = "查無此 PN"
      End If
    Next
End With
作者: jackyq    時間: 2018-10-21 07:38

B change as E
作者: jesscc    時間: 2018-10-21 08:57

B change as E
jackyq 發表於 2018-10-21 07:38


已改，可正常執行，但我的疑問是如果把第一段這句 "Option Base 1" 拿掉，整個資料傳回結果會向右偏一欄，我只知道這是陣列索引下限值的問題，如果在不設定下限值的情形下，要如何改寫原來的陣列排列?
作者: jackyq    時間: 2018-10-21 10:26

回復 6# jesscc


    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








Dim Ar(10)  change as Dim Ar(1 To 10)
作者: 准提部林    時間: 2018-10-21 11:00

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
作者: Kubi    時間: 2018-10-21 20:02

回復 3# jesscc

若沒有宣告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 拿掉的話，整個資料傳回結果會向右偏一欄就是這個道理。
作者: jesscc    時間: 2018-10-21 20:51

回復 9# Kubi
謝謝K大，了解了。
作者: Andy2483    時間: 2023-5-16 14:04

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

資料表:
[attach]36368[/attach]

結果表執行前:
[attach]36369[/attach]

執行結果:
[attach]36370[/attach]


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&, j&, Q&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
With 工作表1: Arr = Range(.[L6], .[B65536].End(3)): End With
'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
For i = 1 To UBound(Arr):  Y(Arr(i, 1)) = i: Next
'↑令Arr陣列的迴圈列第1欄值當key,item是i迴圈變數(以字典紀錄鍵值與列號)
With 工作表2
   .[F7].Resize(1000, 10).ClearContents
   '↑令結果表清除儲存格舊結果
   Brr = Range(.[E7], .[E65536].End(3))
   '↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
End With
ReDim Crr(1 To UBound(Brr), 1 To 10)
'↑令宣告Crr變數是 二維空陣列,縱向範圍同Brr,橫向範圍索引號1~10
For i = 1 To UBound(Brr)
'↑設順迴圈
   Q = Y(Brr(i, 1))
   '↑令Q變數帶出Brr陣列1欄關鍵字在Y字典裡紀錄的Arr陣列列號
   If Q = 0 Then Crr(i, 1) = "查無此PN": GoTo i01
   '↑如果Q變數是 0,代表Arr陣列裡無此鍵,只在註記欄位做註記
   For j = 1 To 10: Crr(i, j) = Arr(Q, j + 1): Next
   '↑設迴圈將Arr陣列值帶入Crr陣列
i01: Next
[工作表2!F7].Resize(UBound(Crr), 10) = Crr
'↑令Crr陣列值從[工作表2!F7]開始,倒入儲存格中
Set Y = Nothing: Erase Arr, Brr, Crr
'↑令釋放變數
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)