12
返回列表 上一主題 發帖

[發問] 兩工作表比對 新增修改

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
11# 跳轉到 »
發表於 2014-1-17 08:01 | 只看該作者
回復 5# Hsieh

請問一下板大

原先我是以D欄為主

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

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

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

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

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

請教一下大大

謝謝 :  )
用功到世界末日那一天∼∼∼

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2014-1-16 08:21 | 只看該作者
回復 9# Hsieh

早安 哈哈

你好早喔

謝謝板大的說明
用功到世界末日那一天∼∼∼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2014-1-16 08:06 | 只看該作者
回復 8# li_hsien


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

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 2014-1-16 07:48 | 只看該作者
回復 7# Hsieh

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

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

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

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


謝謝板大的不吝指教
用功到世界末日那一天∼∼∼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2014-1-15 12:07 | 只看該作者
回復 6# li_hsien

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

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2014-1-15 09:20 | 只看該作者
回復 5# Hsieh

請問大大

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

為什麼要連用兩次Application.Transpose

且我看不出哪一段是比對兩者不同
進行新增或刪除的部分
用功到世界末日那一天∼∼∼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 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
學海無涯_不恥下問

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
4#
發表於 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

還是另有更好的作法


謝謝大大 :  )
用功到世界末日那一天∼∼∼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
219  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 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
複製代碼
match.zip (20.51 KB)
用功到世界末日那一天∼∼∼

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
12
返回列表 上一主題