li_hsien

回復 5# Hsieh

請問一下板大

原先我是以D欄為主

現行改為
依三個欄位來比對

變成是看A,B,D三個欄位
ABD一起看來判別是一筆

也就是說光單看A或B或D會有重複

必須A,B,D一起看才能夠判定

這樣我必須怎麼修正???

請教一下大大

謝謝 :  )

li_hsien

回復 9# Hsieh

早安 哈哈

你好早喔

謝謝板大的說明

Hsieh

回復 8# li_hsien


    一維陣列是指單列資料的集合，是橫向的。
其陣列索引樣式為arr(0)
二維陣列則為多列，所有資料分佈成面。
其陣列索引樣式為arr(0，0)
因為儲存格範圍，EXCEL會視為二維陣列
所以如果儲存格範圍為單列，如[A1:F1]
如果一次轉置，會變成直向陣列，是二維陣列
再一次轉置後，變成橫向，就是一維陣列。

li_hsien

回復 7# Hsieh

版主意思是儲存格實際上是二維
但字典的形式是一維

所以要先轉成一維放進字典
之後在轉一次變成二維放進儲存格中嗎???

以下是在儲存格呈現的方式
A   B   C   D   E     ->儲存格上這樣是二維??

A->這樣是一維嗎??
B
C
D
E
還是怎麼呈現都無關，只要是儲存格上皆是二維???


謝謝板大的不吝指教

Hsieh

回復 6# li_hsien

這是利用字典物件的不重複索引特性，將所有的資料寫入字典內容
因為儲存格範圍被視為二維陣列，但因為單列的資料用transpose函數做二次轉置，就會變成一維陣列
將這些一維陣列存入字典內容，字典內容就是多個一維陣列所組成，再經過二次轉置就可成為真正的二維陣列
因為你的match工作表需保留原內容，在最後才讀入就不會被A，B所覆蓋

li_hsien

回復 5# Hsieh

請問大大

我不太懂
Application.Transpose(Application.Transpose(A.Offset(, -3).Resize(, 6).Value))
的用意

為什麼要連用兩次Application.Transpose

且我看不出哪一段是比對兩者不同
進行新增或刪除的部分

Hsieh

1. Sub ex()
   
2. Dim A As Range, Sh As Worksheet
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For Each Sh In Sheets(Array("User A", "User B", "Match A & B"))
   
5. With Sh
   
6.    For Each A In .Range(.[D1], .[D1].End(xlDown))
   
7.       d(A.Value) = Application.Transpose(Application.Transpose(A.Offset(, -3).Resize(, 6).Value))
   
8.    Next
   
9. End With
   
10. Next
    
11. Sheets("Match A & B").[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
    
12. End Sub

複製代碼

回復 4# li_hsien

li_hsien

回復 3# Hsieh

是以ID為主要比對的項目沒錯

把USER A , USER B 彙整成MATCH  A & B
基本上USER A 與 USER B裡面資料若ID一樣
其他欄位也都會一樣
所以取先取後都可以

目前我碰上主要的問題是E,F欄位
是在MATCH後才會填寫的

所以在USER A 或USER B加欄位後再MATCH
原先填在E,F的欄位就不能對齊了

且如果再USER A或USER B有刪除則MATCH裡面的也會被刪除(E,F也會)

EX:

原本的MATCH

A            B            C                   D               E                        F
123       456       2013.01     AAA         TEST123         TEST456

在USER中加入一欄在原先ID AAA的上面
A            B            C                   D      
777       888       2013.02     BBB     
123       456       2013.01     AAA


則MATCH後會變成
A            B            C                   D               E                        F
777       888       2013.02     BBB          TEST123         TEST456
123       456       2013.01     AAA

正確應該為
A            B            C                   D               E                        F
777       888       2013.02     BBB         
123       456       2013.01     AAA         TEST123         TEST456


目前我附檔的程式碼好像可以做到

但不知O不OK

還是另有更好的作法


謝謝大大 :  )

Hsieh

回復 2# li_hsien

是比對重複ID嗎?請說明重複的定義
要記錄的是每個ID的最後出現的資料，還是最先出現的資料?
試試紀錄最後出現的ID資料

1. Sub ex()
   
2. Dim Sh As Worksheet, A As Range
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. For Each Sh In Sheets(Array("User A", "User B"))
   
5. With Sh
   
6.   For Each A In .Range(.[D1], .[D1].End(xlDown))
   
7.   ar = Application.Transpose(Application.Transpose(A.Offset(, -3).Resize(, 4)))
   
8.   mystr = Join(ar, Chr(10))
   
9.      dic(A.Value) = Split(mystr, Chr(10))
   
10.   Next
    
11. End With
    
12. Next
    
13. Sheets("Match A & B").[A1].Resize(dic.Count, 4) = Application.Transpose(Application.Transpose(dic.items))
    
14. End Sub

複製代碼

li_hsien

謝謝大大

當初好像把流程想得太複雜 哈

後來有整理出個方法

目前應該可行

不知有無其他方式

附檔是直接把userA,userB抓進來了
(把外部資料來源省略)

欄底部分的欄位是MATCH後才填寫的

userA,userB不能填

1. Sub match_Click()
   
2.    
   
3.     'Copy userA
   
4.     For i = 2 To Sheets(2).Range("A1").End(xlDown).Row
   
5.         '判別來源有無重複,且MATCH表沒有的(貼最下面)
   
6.         If Application.match(Sheets(2).Range("D" & i), Sheets(2).Range("D:D"), 0) = i And _
   
7.                 IsError(Application.match(Sheets(2).Range("D" & i), Range("D:D"), 0)) = True Then
   
8.             userA_rows = Range("A65536").End(xlUp).Row + 1
   
9.             Sheets(2).Range("A" & i & ":D" & i).Copy Range("A" & userA_rows & ":D" & userA_rows)
   
10.         '判別來源有無重複,且MATCH表上有的(貼在MATCH位置)
    
11.         ElseIf Application.match(Sheets(2).Range("D" & i), Sheets(2).Range("D:D"), 0) = i And _
    
12.                 IsError(Application.match(Sheets(2).Range("D" & i), Range("D:D"), 0)) = False Then
    
13.             site_A = Application.match(Sheets(2).Range("D" & i), Range("D:D"), 0)
    
14.             Sheets(2).Range("A" & i & ":D" & i).Copy Range("A" & site_A & ":D" & site_A)
    
15.         End If
    
16.     Next
    
17. 
    
18.     'Copy userB
    
19.     For j = 2 To Sheets(3).Range("A1").End(xlDown).Row
    
20.         '判別來源有無重複,且MATCH表沒有的(貼最下面)
    
21.         If Application.match(Sheets(3).Range("D" & j), Sheets(3).Range("D:D"), 0) = j And _
    
22.                 IsError(Application.match(Sheets(3).Range("D" & j), Range("D:D"), 0)) = True Then
    
23.             userB_rows = Range("A65536").End(xlUp).Row + 1
    
24.             Sheets(3).Range("A" & j & ":D" & j).Copy Range("A" & userB_rows & ":D" & userB_rows)
    
25.         '判別來源有無重複,且MATCH表有的(貼在MATCH位置)
    
26.         ElseIf Application.match(Sheets(3).Range("D" & j), Sheets(3).Range("D:D"), 0) = j And _
    
27.                 IsError(Application.match(Sheets(3).Range("D" & j), Range("D:D"), 0)) = False Then
    
28.             site_B = Application.match(Sheets(3).Range("D" & j), Range("D:D"), 0)
    
29.             Sheets(3).Range("A" & j & ":D" & j).Copy Range("A" & site_B & ":D" & site_B)
    
30.         End If
    
31.     Next
    
32. 
    
33.     '與userA,userB比對 刪除沒有的
    
34.     For x = 2 To Range("A1").End(xlDown).Row
    
35.         If IsError(Application.match(Range("D" & x), Sheets(2).Range("D:D"), 0)) = True And _
    
36.             IsError(Application.match(Range("D" & x), Sheets(3).Range("D:D"), 0)) = True Then
    
37.             Rows(x).Delete
    
38.         End If
    
39.     Next
    
40. End Sub

複製代碼

match.zip (20.51 KB)

下載次數: 12

2014-1-13 09:07