返回列表 上一主題 發帖

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

回復 1# jackyliu
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Object, E, I As Integer
  4.     Set D = CreateObject("Scripting.dictionary")             '字典物件
  5.     For Each E In Sheet1.Range("a1").CurrentRegion.Rows      '物件: A1所延伸範圍的列
  6.          D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  7.     Next
  8.     With Sheet2
  9.         .Cells.Clear
  10.         I = 1
  11.         For Each E In D.KEYS
  12.             .Cells(I, "A").Resize(1, UBound(D(E), 2)) = D(E)   '讀取字典物件的ITEM(陣列)
  13.         I = I + 1
  14.         Next
  15.     End With
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# jackyliu
給的程式碼是以 Sheet1A1所延伸範圍的列 為 Sheet1 的資料
For Each E In Sheet1.Range("a1").CurrentRegion.Rows      '物件: A1所延伸範圍的列
你測試檔案中 Sheet1 的資料 在哪裡?? 須附上你測試檔才了解
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# jackyliu
可能是版本的差異2000版沒用過,不知錯誤在哪裡,2003執行沒有錯誤的
請找出錯誤點如圖





何判定已存在,有重複內容,不執行寫入Sheet2裡
程式碼如下
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D1 As Object, D2 As Object, E, I As Integer, S As String
  4.     Set D1 = CreateObject("Scripting.dictionary")                   '字典物件
  5.     Set D2 = CreateObject("Scripting.dictionary")                   '字典物件
  6.     For Each E In Sheet1.Range("a1").CurrentRegion.Rows             '物件: A1所延伸範圍的列
  7.          S = E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)  'S=>key值
  8.          D1(S) = E.Value                                            '有相同的key值-> E範圍的值(陣列) 讀入到Item
  9.          D2(S) = D2(S) + 1                                          '有相同的key值-> item +1
  10.     Next
  11.     With Sheet2
  12.         .Cells.Clear
  13.         I = 1
  14.         For Each E In D2.KEYS
  15.             If D2(E) = 1 Then                                       'D2沒重覆的key值 -> item= 1
  16.                 .Cells(I, "A").Resize(1, UBound(D1(E), 2)) = D1(E)  '讀取D1相同的key值: 導入D1的Item(陣列)
  17.                 I = I + 1
  18.             End If
  19.         Next
  20.     End With
  21. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# c_c_lai
煩請在加上.Value測試看看
  1.         For Each E In D.KEYS
  2.             .Cells(I, "A").Resize(1, UBound(D(E), 2)).Value = D(E)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# c_c_lai
辛苦了,請換個變數名稱試試看
  1. For Each K In D.KEYS
  2.             .Cells(I, "A").Resize(1, UBound(D(K), 2)) = D(K)   
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# c_c_lai
謝謝你,你已儘全力,莫可耐何它了
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

TOP

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

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

回復 24# c_c_lai
2003版沒有的問題,怎會在2007版出現,謝謝你的幫忙偵錯.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 愛不是要求對方,而是要由自身的付出。
返回列表 上一主題