c_c_lai

回復 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 (陣列)

複製代碼

c_c_lai

回復 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

複製代碼

處裡階段出了問題。 應該將重複值予以過濾調。

jackyliu

重複值予以過濾調,和我說的重複值,不要複製到 Sheet2 的意思嗎?
有解嗎?

c_c_lai

回復 20# GBKEE
回復 23# jackyliu

1. Option Explicit
   
2. 
   
3. Sub ex()
   
4.     Dim D As Object, E As Variant, cts As Integer
   
5.    
   
6.     Set D = CreateObject("Scripting.dictionary")         '  字典物件
   
7.    
   
8.     For Each E In Sheet1.Range("A1").CurrentRegion.Rows  '  物件: A1 所延伸範圍的列
   
9.         If D.exists(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = False Then _
   
10.                D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
    
11.     Next
    
12.    
    
13.     With Sheet2
    
14.         .Cells.Clear
    
15.         cts = 1
    
16.         For Each E In D.KEYS
    
17.             .Cells(cts, "A").Resize(1, UBound(D(E), 2)).Value = D(E)   '  讀取字典物件的 ITEM (陣列)
    
18.         cts = cts + 1
    
19.         Next
    
20.     End With
    
21. 
    
22.     Set D = Nothing
    
23. End Sub

複製代碼

加入了過濾判斷，If D.exists(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = False Then ....，
jackyliu 請再試看看！

GBKEE

回復 24# c_c_lai
2003版沒有的問題,怎會在2007版出現,謝謝你的幫忙偵錯.

jackyliu

板大:
我是用2003版的, 直接按執行OK, 執行三次後,
我選擇逐步偵錯,一個一個看,  又會出現一樣的錯誤耶!

執行階段錯誤'13'
型態不符

luhpro

板大:
我是用2003版的, 直接按執行OK, 執行三次後,
我選擇逐步偵錯,一個一個看,  又會出現一樣的錯誤耶!
...
jackyliu 發表於 2013-7-25 21:55

如果在建立之初就把 無 濾掉是否有可能達到你的需求呢?

1. .
   
2.     For Each E In Sheet1.Range("a1").CurrentRegion.Rows      '物件: A1所延伸範圍的列
   
3.     If Not E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5) = "" Then
   
4.          D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
   
5.       End If
   
6.     Next

複製代碼

GBKEE

回復 26# jackyliu
再試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, E, i As Integer
   
4.     Set D = CreateObject("Scripting.dictionary")             '字典物件
   
5.     i = 1
   
6.     With Sheet1
   
7.         Do While .Cells(i, "A") <> ""
   
8.             E = .Cells(i, "A") & .Cells(1, "B") & .Cells(1, "C") & .Cells(1, "E")
   
9.             If D.exists(E) = False Then
   
10.                D(E) = .Cells(i, "A").Resize(1, 6).Value
    
11.             End If
    
12.             i = i + 1
    
13.         Loop
    
14.     End With
    
15.     i = 1
    
16.     With Sheet2
    
17.         .Cells.Clear
    
18.         For Each E In D.KEYS
    
19.             .Cells(i, "A").Resize(1, UBound(D(E), 2)) = D(E)   '讀取字典物件的ITEM(陣列)
    
20.             i = i + 1
    
21.         Next
    
22.     End With
    
23. End Sub

複製代碼

c_c_lai

回復 28# GBKEE
回復 26# jackyliu
試著將以下程式碼修

1. For Each E In D.KEYS
   
2.     .Cells(cts, "A").Resize(1, UBound(D(E), 2)).Value = D(E)   '  讀取字典物件的 ITEM (陣列)
   
3.     cts = cts + 1
   
4. Next

複製代碼

改成

1. For Each E In D.KEYS
   
2.     If E <> "" Then _
   
3.         .Cells(cts, "A").Resize(1, UBound(D(E), 2)).Value = D(E)   '  讀取字典物件的 ITEM (陣列)
   
4.     cts = cts + 1
   
5. Next

複製代碼

再將它操練一下。

P.S. 回覆人家時，請使用選按 "回覆" 鈕，否則當事人是不知道妳已回覆問題了！
       (這也是一種傳統禮節)

jackyliu

回復 29# c_c_lai


    Sorry ~  我以為是使用 最底下的  發表回復,
下次直接點選文章裡的回覆 ~ 造成困擾,請見諒 !!