Board logo

標題: [發問] 兩工作表比對 新增修改 [打印本頁]
作者: li_hsien    時間: 2014-1-10 11:37     標題: 兩工作表比對 新增修改

這問題讓我有點頭大@@

整體作業流程是這樣的

我有2份EXCEL(X,Y)，去除掉重複值合成1份EXCEL(Z)
(X,Y->Z)

格式欄位都一樣

目前我是用外部資料的方式

每次打開Z都會更新X,Y的資料

將X,Y的資料抓進Z的sheet2,sheet3
(X=Z的sheet2, Y=Z的sheet3)

這麼做是想說我在Z上作業就好了

如果單純把sheet2,sheet3的資料抓進sheet1,刪除重複值就是我要的了


但現在最大問題是
最後產出的sheet1有幾個欄位會讓使用者填寫,但這些欄位是在X,Y的時候不用填寫的
(設定資料連結的時候只設定sheet2,sheet3會做的欄位,sheet1才會填寫的欄位沒有做連結,因為如果都做連結那更新後就會變空的)



這樣的話我每次做一次更新合併
就會讓原本填寫在sheet1上的資料錯亂掉(因為sheet2,sheet3會變動)

EX:
欄位->            A            B               C(在sheet1時才會輸入資料)

在sheet2       000        111     
在sheet3       222        333

>sheet1        000        111         AAA
                         222        333         BBB


<<更新後>>
欄位->            A            B               C(在sheet1時才會輸入資料)

在sheet2       000        111   
                         444        555
在sheet3       222        333

>sheet1        000        111         AAA
                         444        555         BBB   
                         222        333         



表達上有些複雜

不知各位大大有沒有什麼想法可以改善

麻煩了 謝謝  :  )
作者: li_hsien    時間: 2014-1-13 09:10

謝謝大大

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

後來有整理出個方法

目前應該可行

不知有無其他方式

附檔是直接把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

  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

  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
複製代碼
[attach]17244[/attach]
作者: Hsieh    時間: 2014-1-13 15:50

回復 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    時間: 2014-1-14 15:16

回復 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    時間: 2014-1-14 22:52

  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    時間: 2014-1-15 09:20

回復 5# Hsieh

請問大大

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

為什麼要連用兩次Application.Transpose

且我看不出哪一段是比對兩者不同
進行新增或刪除的部分
作者: Hsieh    時間: 2014-1-15 12:07

回復 6# li_hsien

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

回復 7# Hsieh

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

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

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

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


謝謝板大的不吝指教
作者: Hsieh    時間: 2014-1-16 08:06

回復 8# li_hsien


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

回復 9# Hsieh

早安 哈哈

你好早喔

謝謝板大的說明
作者: li_hsien    時間: 2014-1-17 08:01

回復 5# Hsieh

請問一下板大

原先我是以D欄為主

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

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

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

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

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

請教一下大大

謝謝 :  )
作者: Hsieh    時間: 2014-1-17 09:07

  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.       mystr = A.Offset(, -3) & A.Offset(, -2) & A
  8.       d(mystr) = Application.Transpose(Application.Transpose(A.Offset(, -3).Resize(, 6).Value))
  9.    Next
  10. End With
  11. Next
  12. Sheets("Match A & B").[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
  13. End Sub
複製代碼
回復 11# li_hsien
作者: li_hsien    時間: 2014-1-17 10:38

回復 12# Hsieh

板大 如果我欄位沒有一致
(A,B一樣但和A&B的不一樣)

會變動那該如何表示呢???

因為用Transpose應該是整欄整列吧
作者: Hsieh    時間: 2014-1-17 10:44

回復 13# li_hsien


    不懂什麼A,B一樣A&B不一樣
把資料上傳說明看看
作者: li_hsien    時間: 2014-1-17 11:06

回復 14# Hsieh

型號&類別&ID為主要判斷準則

UserA , UserB的欄位都一樣

將兩個工作表抓到matchA&B

藍底為matchA&B才會填的欄位


UserA,UserB抓過去的時候

必須對應欄位
如果UserA沒有的，但matchA&B有的欄位(EX:使用者)則留空

因為和matchA&B欄位不一樣
所以不知該如何用原先的方式對應


附檔裡的matchA&B為該產出的結果

麻煩幫我看看 謝謝 : )

[attach]17280[/attach]
作者: yen956    時間: 2014-1-19 19:25

回復 1# li_hsien

非常感謝謝 Hsieh 的程式與說明,
總算對 Scripting.Dictionary,Transpose 有初步的概念,
謝謝!!
to Hi-Hsieh:因為我是小學生, 無權下載檔案,
可否將你的檔案 mail 給我, 因我很想研究這個程式, 程式太神奇了
[email protected]
作者: Hsieh    時間: 2014-1-20 09:57

回復 15# li_hsien
是這樣的意思嗎?
若USER有對照到MATCH_A&B則更新MATCH_A&B
若無對照到MATCH_A&B應則新增USER資料列到MATCH_A&B
若MATCH_A&B資料未出現在USER則保留
  1. Sub ex()

  3.     Dim A As Range, Sh As Worksheet
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     For Each Sh In Sheets(Array("User A", "User B"))
  6.     With Sh
  7.        For Each A In .Range(.[C2], .[C2].End(xlDown))
  8.           Debug.Print A
  9.           d(A & A.Offset(, 1) & A.Offset(, 2)) = Array(A.Value, Sh.Name, A.Offset(, 1).Value, A.Offset(, -1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, "", A.Offset(, 4).Value)
  10.        Next
  11.     End With
  12.     Next
  13.     With Sheets("Match A & B")
  14.       For Each A In .Range(.[A2], .[A2].End(xlDown))
  15.          mystr = A & A.Offset(, 2) & A.Offset(, 4)
  16.          If d.exists(mystr) Then A.Resize(, 8) = d(mystr): d.Remove mystr
  17.       Next
  18.       For Each ky In d.keys
  19.         .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 8) = d(ky)
  20.       Next
  21.    End With
  22. End Sub
複製代碼
作者: li_hsien    時間: 2014-1-20 13:33

本帖最後由 li_hsien 於 2014-1-20 13:34 編輯

回復 17# Hsieh

[attach]17319[/attach]

MATCH比對方式是對的

不過要COPY的只有藍色前面的部分
If d.exists(mystr) Then A.Resize(, 5) = d(mystr): d.Remove mystr
我把8改成5好像就可以了

不過有一個地方怪怪的

就是MATCH的來源是依UsetA,UserB來的

所以如果UserA,UserB沒有的
MATCH那邊必須整欄都刪掉

也就是說
UserA,UserB有的,Match才需要留著


大大的語法好"新"的感覺XDD

幾乎都沒看過 哈哈

我得研究研究了
作者: Hsieh    時間: 2014-1-20 14:34

回復 18# li_hsien
15#說到
如果UserA沒有的，但matchA&B有的欄位(EX:使用者)則留空
表示USER內無資料則保留原存在於MATCH的資料
18#說到
MATCH的來源是依UsetA,UserB來的
所以如果UserA,UserB沒有的
MATCH那邊必須整欄都刪掉
這是完全不管MATCH的資料，只留下USER的資料
這兩種敘述好像是衝突的
作者: li_hsien    時間: 2014-1-20 17:25

回復 19# Hsieh

板大不好意思 我敘述上好像會造成誤解

我整理一下
資料來源來自於UserA , UserB
但是UserA , UserB的欄位只有到E欄位"週別        Date        型號        類別        ID"
後面藍色的我忘了刪掉

MATCH後

Match A & B
來自於UserA , UserB
(比對原則依據先前所提的紅字部分->3個(型號,類別,ID)為一組)

但是如果Match A & B 後面藍色部分有資料
下次MATCH的時候

資料一樣來自於
UserA , UserB
可是Match A & B後面藍色部分必須保留

除非UserA , UserB 那邊資料沒了
Match A & B也要跟著整欄刪

EX:

UserA
->  AAA   BBB   CCC
       AAA   BBB    DDD
Match A & B
-> AAA   BBB   CCC    TEST123(前三個為比對的依據，第四個為Match A & B才填入的資料)
      AAA   BBB   DDD    TEST456


<再次MATCH>

UserA(資料改變了)
-> AAA  BBB  EEE
      AAA  BBB  DDD

Match A & B
-> AAA BBB DDD TEST456 (因為一開始比對時有這筆，再次比對一樣又出現時，後面那個資料要留下來)
      AAA BBB  EEE                     (此為新出現的，補在後面)




以上不知這樣清不清楚XDD

煩請大大幫忙看看

如不清楚我再說明

謝謝



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)