返回列表 上一主題 發帖

[發問] 檢查重複性質的資料

回復 20# GBKEE
終於找到問題徵結點了。 當執行完後
  1. For Each E In Sheet1.Range("A1").CurrentRegion.Rows
  2.     D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  3. Next
複製代碼
D.KEYS 陣列值內容應該共有六個,即:
  1. '  D.KEYS :  : Variant/Variant(0 to 5) : ThisWorkbook.ex
  2. '  D.KEYS(0) : "姓名地區性別婚姻" : Variant/String : ThisWorkbook.ex
  3. '  D.KEYS(1) : "小李台北女已婚" : Variant/String : ThisWorkbook.ex
  4. '  D.KEYS(2) : "小劉桃園男已婚" : Variant/String : ThisWorkbook.ex
  5. '  D.KEYS(3) : "小陳新竹女未婚" : Variant/String : ThisWorkbook.ex
  6. '  D.KEYS(4) : "小張中壢女未婚" : Variant/String : ThisWorkbook.ex
  7. '  D.KEYS(5) : "小湯台中男已婚 " : Variant/String : ThisWorkbook.ex
複製代碼
此時,則執行一切順利。 反之,當處理陣列結果為下列情況時:
  1. '  D.KEYS :  : Variant/Variant(0 to 8) : ThisWorkbook.ex
  2. '  D.KEYS(0) : "姓名地區性別婚姻" : Variant/String : ThisWorkbook.ex
  3. '  D.KEYS(1) : "小李台北女已婚" : Variant/String : ThisWorkbook.ex
  4. '  D.KEYS(2) : "小劉桃園男已婚" : Variant/String : ThisWorkbook.ex
  5. '  D.KEYS(3) : 0 : Variant/Integer : ThisWorkbook.ex
  6. '  D.KEYS(4) : 1 : Variant/Integer : ThisWorkbook.ex
  7. '  D.KEYS(5) : 2 : Variant/Integer : ThisWorkbook.ex
  8. '  D.KEYS(6) : "小陳新竹女未婚" : Variant/String : ThisWorkbook.ex
  9. '  D.KEYS(7) : "小張中壢女未婚" : Variant/String : ThisWorkbook.ex
  10. '  D.KEYS(8) : "小湯台中男已婚 " : Variant/String : ThisWorkbook.ex
複製代碼
上帝、佛祖啊!
當圍圈執行到 D.KEYS(3)、D.KEYS(4)、D.KEYS(5) 就中樂透了。
這表示在
  1. For Each E In Sheet1.Range("A1").CurrentRegion.Rows
  2.     D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  3. Next
複製代碼
處裡階段出了問題。 應該將重複值予以過濾調。

TOP

本帖最後由 c_c_lai 於 2013-7-25 10:02 編輯

回復 20# GBKEE
您目前看到的 E 或者是 E As Variant 都已多方測試過,
當時 E 為何修改成 明確宣告亦是此由來。
目前只等待 jackyliu 的測試結果了,
我想極有可能真的是 Assign 的問題,
因為問題發生時我有關查到
  1.         For Each E In Dk.KEYS
  2.             '  E 傳入值為 "無", 以致發生以下延生的 "型態不符" 錯誤訊息
  3.             .Cells(cts, "A").Resize(1, UBound(Dk(E), 2)).Value = Dk(E)   '  讀取字典物件的 ITEM (陣列)
複製代碼

TOP

回復 19# c_c_lai
15# 有問到  Hsieh超版 13# 的試了,沒如沒錯誤可照著改試試看   
你18# 程式碼, 只差我沒書明 E As Variant
  1. Dim Dk As Object, E As Variant, cts As Integer
  2.       'Dim Dk As Object, E, cts As Integer
複製代碼

請在我的程式碼版本中,書明 E As Variant 再測試看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 16# jackyliu
回復 17# GBKEE
問題可能出在
  1. D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
複製代碼
Hsieh 版大應用了
  1. d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
複製代碼
在陣列值移轉中透過   Application.Transpose(),使得數值得以正確 Assign,其穩定度比直接
Assign 會來得確實、資料 Assigment 中較不易流失。我將 Hsieh 版大的程式加上變數宣告,
載於如下:
  1. Sub ex()                                              '  Hsieh
  2.     Dim d As Object, a As Range, mystr As String
  3.    
  4.     Set d = CreateObject("Scripting.Dictionary")

  5.     With Sheet1
  6.         For Each a In .Range(.[A1], .[A1].End(xlDown))
  7.             mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
  8.             '  If d.exists(mystr) Then MsgBox a & "資料重複"
  9.             d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
  10.         Next
  11.     End With
  12.    
  13.     With Sheet2
  14.         .Cells.ClearContents
  15.         .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
  16.     End With
  17. End Sub
複製代碼

TOP

回復 16# jackyliu
這是經過我測試過 OK 的,雖然內容大致一樣,
但還是使用我的程式碼試試看。
(之前我亦測出你所說的狀況,試試這隻看看,其中也將 Debug 的過程內容亦併作成註釋)
  1. Option Explicit

  2. Sub Ex()
  3.     Dim Dk As Object, E As Variant, cts As Integer
  4.     '  Dim Dk As Object, E, cts As Integer
  5.    
  6.     Set Dk = CreateObject("Scripting.dictionary")         '  字典物件
  7.    
  8.     '  1. 將 Sheet1 的資料,複製到 Sheet2 的 A1 位置開始,依序寫入.
  9.     '  2. 重複性的資料,不要再重複複製到Sheet2
  10.     '  3. 比較不可重複欄位:姓名,地區,性別,婚姻
  11.     For Each E In Sheet1.Range("A1").CurrentRegion.Rows  '  物件: A1 所延伸範圍的列
  12.         '  E.Value : Variant/Variant(1 to 1, 1 to 6) : ThisWorkbook.Ex
  13.         '  E.Value(1,1) : "姓名" : Variant/String : ThisWorkbook.Ex2
  14.         '  E.Value(1,2) : "地區" : Variant/String : ThisWorkbook.Ex2
  15.         '  E.Value(1,3) : "性別" : Variant/String : ThisWorkbook.Ex2
  16.         '  E.Value(1,4) : "教育程度" : Variant/String : ThisWorkbook.Ex2
  17.         '  E.Value(1,5) : "婚姻" : Variant/String : ThisWorkbook.Ex2
  18.         '  E.Value(1,6) : "子女" : Variant/String : ThisWorkbook.Ex2
  19.         Dk(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  20.     Next
  21.    
  22.     With Sheet2
  23.         .Cells.Clear
  24.         cts = 1
  25.         For Each E In Dk.KEYS
  26.             '  UBound(Dk(E), 1) : 1 : Long : ThisWorkbook.Ex
  27.             '  UBound(Dk(E), 2) : 6 : Long : ThisWorkbook.Ex
  28.             '  E : "姓名地區性別婚姻" : Variant/String : ThisWorkbook.Ex2
  29.             '  E : "小李台北女已婚" : Variant/String : ThisWorkbook.Ex2
  30.             '  E : "小劉桃園男已婚" : Variant/String : ThisWorkbook.Ex2
  31.             .Cells(cts, "A").Resize(1, UBound(Dk(E), 2)).Value = Dk(E)   '  讀取字典物件的 ITEM (陣列)
  32.         cts = cts + 1
  33.         Next
  34.     End With
  35. End Sub
複製代碼
請把以上複製的程式碼放入到 ThisWorkbook 程式碼區內執行。
P.S.  目前在我的檔案中 Module1 區亦放入相同程式碼分別測試結果 (Sub 名稱不同),
        這是為了方便測試 "型態不符" 問題所在之故。

TOP

回復 16# jackyliu
我只有2003版執行一直好好的, 無法查出你的錯誤在哪裡.
c_c_lai 也幫忙測試其他版本有時會有錯誤.(不了解為何如此)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

版大:
       程式碼換上最後版, 一樣會出現 ---> 執行階段錯誤'13' 型態不符
程式偵錯停滯在 更新的那段, 看不出來是什麼問題, 版大可以幫忙一下嗎?

     .Cells(I, "A").Resize(1, UBound(D(K), 2)) = D(K)

TOP

回復 14# jackyliu
Hsieh超版 13# 的試了,沒如沒錯誤可照著改試試看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

版大 :
一樣是 執行階段錯誤'13'型態不符
時可以有時有錯誤,是不接受這樣的寫法嗎?
不知道是哪出了問題 ?

型態不符.jpg (31.33 KB)

型態不符

型態不符.jpg

TOP

  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With 工作表1
  4.    For Each a In .Range(.[A1], .[A1].End(xlDown))
  5.       mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
  6.       If d.exists(mystr) Then MsgBox a & "資料重複"
  7.       d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
  8.    Next
  9. End With
  10. With 工作表2
  11. .Cells.ClearContents
  12. .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
  13. End With
  14. End Sub
複製代碼
回復 5# jackyliu
學海無涯_不恥下問

TOP

        靜思自在 : 布施如播種,以歡喜心滋潤種子,才會發芽。
返回列表 上一主題