本帖最後由 ivan731129 於 2011-2-25 13:45 編輯
之前是將兩筆不同資料整理成一份，但之前是ㄧ家公司含多筆同產品產量資料對應一筆公司地址資料
那後來想修改成ㄧ家公司含一筆產品產量資料對應一筆公司地址資料
因此修改成以下- Sub Ex()
- Dim A As Range
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- d1("機構管編") = Array("機構管編", "機構名稱", "代碼", "代碼中文名稱", "最大月產生量", "事業機構地址", "負責人姓名", "負責人職稱", "負責人電話", "環保部門名稱", "環保部門負責人", "環保部門電話", "廢清書公告類別")
- With Sheet2
- For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
- 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)
- Next
- End With
- With Sheet1
- For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
- If IsEmpty(d1(A & A.Offset(, 10) & A.Offset(, 1))) Then
-
- 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))
-
- Else
- ar = d1(A & A.Offset(, 10) & A.Offset(, 1))
-
- If A.Offset(, 10).Value > ar(4) Then ar(4) = A.Offset(, 10).Value
- d1(A & A.Offset(, 10) & A.Offset(, 1)) = ar
-
- End If
- Next
- End With
- Sheet5.[A1].Resize(d1.Count, 19) = Application.Transpose(Application.Transpose(d1.items))
- End Sub
是在哪個部份沒索引到呢? 主要就是要做重複資料篩承單筆資料。 |
發表於 2011-2-25 09:22
| 
