[發問] 之前詢問過兩筆不同資料整合，目前又遇到ㄧ些問題。(以附檔)

ivan731129

之前是將兩筆不同資料整理成一份，但之前是ㄧ家公司含多筆同產品產量資料對應一筆公司地址資料
那後來想修改成ㄧ家公司含一筆產品產量資料對應一筆公司地址資料
因此修改成以下

1. Sub Ex()
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. d1("機構管編") = Array("機構管編", "機構名稱", "代碼", "代碼中文名稱", "最大月產生量", "事業機構地址", "負責人姓名", "負責人職稱", "負責人電話", "環保部門名稱", "環保部門負責人", "環保部門電話", "廢清書公告類別")
   
6. 
   
7. With Sheet2
   
8.    For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
9.      d(A.Value) = Array(A.Offset(, 6).Value, A.Offset(, 12).Value, A.Offset(, 13).Value, A.Offset(, 14).Value, A.Offset(, 15).Value, A.Offset(, 16).Value, A.Offset(, 17).Value, A.Offset(, 31).Value)
   
10.   Next
    
11. End With
    
12. With Sheet1
    
13.    For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
    
14.    If IsEmpty(d1(A & A.Offset(, 10) & A.Offset(, 1))) Then      
    
15.   
    
16.       d1(A & A.Offset(, 10) & A.Offset(, 1)) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 6).Value, A.Offset(, 7).Value, A.Offset(, 10).Value, d(A.Value)(0), d(A.Value)(1), d(A.Value)(2), d(A.Value)(3), d(A.Value)(4), d(A.Value)(5), d(A.Value)(6), d(A.Value)(7))
    
17.    
    
18. Else
    
19.      ar = d1(A & A.Offset(, 10) & A.Offset(, 1))
    
20.      
    
21.      If A.Offset(, 10).Value > ar(4) Then ar(4) = A.Offset(, 10).Value
    
22.      d1(A & A.Offset(, 10) & A.Offset(, 1)) = ar
    
23.    
    
24.     End If
    
25.    Next
    
26. End With
    
27. Sheet5.[A1].Resize(d1.Count, 19) = Application.Transpose(Application.Transpose(d1.items))
    
28. End Sub

複製代碼

但是遇到的問題為，不知為何出來的資料會刪掉兩三筆。
是在哪個部份沒索引到呢? 主要就是要做重複資料篩承單筆資料。

ivan731129

因為原本想用進階篩選做不重複資料，但是使用時我的資料型態一直出現錯誤不能執行。
若是用巨集要如何處理設定到新頁面呢?

TESTADDRESS.rar (21.19 KB)

下載次數: 4

2011-2-25 13:43

附檔，簡化的少筆資料和巨集
當資料少時篩選似乎沒問題，但是當套用在原資料時，有些資料會lose掉。
在使用上次詢問修改過的巨集時，取對應多筆產量資料，並不會有lose但是當只想取一筆時才發生問題。
不知是否因為有些最大產量為沒資料的關係嗎?但是後來檢查發現似乎不是這問題。
還有當我地址資料沒那家公司時(刻意刪掉一筆地址資料測試)，巨集會顯示型態不符，是否能夠讓沒地址資料的公司整理後只會讓後面留白呢?
在煩請前輩檢查修改。