Board logo

標題: 資料比對 [打印本頁]
作者: waterfox    時間: 2012-5-14 20:00     標題: 資料比對

請問各位, 如何將一張worksheet與另一張worksheet資料作比對... 如第一張sheet column A and coumn B內資料在第二張sheet 的資料是相同, 就在第二張sheet的column D = 第一張sheet 的column C, 但如果找不到相同資料, 那就在第二張sheet的最尾一行加上這行, 例如

sheet  1
A          B         C
1.    ABC      123
2.   DEC       234
3.   DDF      123
總數有100行

sheet  2
A.       B.        C            D
1.      BBB     234
2.      DEC    222      234
3.      FFF     333
總數有200行

謝謝各位幫忙....
作者: register313    時間: 2012-5-14 22:10

回復 1# waterfox
  1. Sub XX()
  2. Set d = CreateObject("scripting.dictionary")
  3. For Each A In Sheet1.Range("A1:A" & [A1].End(xlDown).Row)
  4.   d(A & "," & A.Offset(0, 1)) = A.Offset(0, 2)
  5. Next
  6. For Each A In Sheet2.Range("A1:A" & [A1].End(xlDown).Row)
  7.   If d.Exists(A & "," & A.Offset(0, 1)) Then
  8.      A.Offset(0, 3) = d(A & "," & A.Offset(0, 1))
  9.      d.Remove (A & "," & A.Offset(0, 1))
  10.   End If
  11. Next
  12. Ar = d.keys
  13. For I = 0 To UBound(Ar)
  14.   Sheet2.[A1].End(xlDown).Offset(1, 0).Resize(1, 2) = Split(Ar(I), ",")
  15. Next I
  16. Sheet2.[C1].End(xlDown).Offset(1, 0).Resize(d.Count, 1) = Application.Transpose(d.items)
  17. End Sub
複製代碼
作者: waterfox    時間: 2012-5-15 13:33

多謝你的回覆呀... 但如果有好多行都不在sheet 2內... 你以上的程式是如果Sheet1 有幾行是在sheet 2找不到的, 那只將找不到的第一行加到sheet 2最尾... 如果要將所有在sheet 1都找不到都加在sheet 2, 那如何處理... 另外如果除了column A, column B 要match 外... 如果要column C and column D都要match 那又如何... 謝謝你呀resigter 313.
作者: register313    時間: 2012-5-15 14:14

回復 3# waterfox

但如果有好多行都不在sheet 2內... 你以上的程式是如果Sheet1 有幾行是在sheet 2找不到的, 那只將找不到的第一行加到sheet 2最尾... 如果要將所有在sheet 1都找不到都加在sheet 2, 那如何處理
=>原先的程式就是將sheet 1找不到都加在sheet 2的最尾
   sheet 1有3行在sheet 2是找不到的,就在sheet 2的最尾加上sheet 1的3行
   sheet 1有5行在sheet 2是找不到的,就在sheet 2的最尾加上sheet 1的5行


... 另外如果除了column A, column B 要match 外... 如果要column C and column D都要match 那又如何... 謝謝你呀resigter 313.
=>是不是先上傳你的excel檔案,比較知道的檔案的結構
作者: waterfox    時間: 2012-5-15 15:57

OK.. 先謝謝... 我遲一點上傳給你看..
作者: waterfox    時間: 2012-5-16 00:28

以下是每個月都有一張存貨表, 例如1月及2月
[attach]10963[/attach]
[attach]10964[/attach]

要將每個月的存貨自動到整年的summary sheet, 但每個item都有不同的入貨價錢, 亦會有新的項目新加的, 就加在該第一column的item number, 例如 (1). 代表Rose, 但幾個月後(1). Rose 會用完存貨後, (1) 會用在其他新的產品上, 例如在三月份 (1) 可能被 另一產品代替, 但(1) Rose 又不可刪除. 所以可否在(1) Rose 以下自動加上一行並加入新的產品名稱及儲貨記錄?
[attach]10965[/attach]

謝謝你的幫忙..
作者: waterfox    時間: 2012-5-16 10:00

[attach]10969[/attach]
[attach]10970[/attach]
[attach]10971[/attach]

thanks
作者: hugh0620    時間: 2012-5-16 10:09

本帖最後由 hugh0620 於 2012-5-16 10:12 編輯

模擬的環境在同一個EXCEL檔中
SHEET1
A             B
ABC      123
DEC      234
DDF     123

SHEET2
A            B
BBB      234
DEC     222
DDF    234
  1. Sub EX()
  2. A = Sheet1.Range("A65536").End(xlUp).Row
  3. For I = 1 To A
  4.     Set F = Sheet2.Columns("A:A").Find(Sheet1.Range("A" & I))  '先比對A欄位是否
  5.     If Not F Is Nothing Then                                   '判斷式:F找不到的話
  6.        F = Sheet2.Columns("A:A").Find(Sheet1.Range("A" & I)).Row
  7.        Set F1 = Sheet2.Range("A" & F & ":A" & F).Find(Sheet1.Range("B" & I))
  8.        If F1 Is Nothing Then                                   '再判斷B值不存在就在下一欄新增
  9.           F2 = Sheet2.Range("IV" & F).End(xlToLeft).Offset(0, 1).Column
  10.           Sheet2.Cells(F, F2) = Sheet1.Range("B" & I)
  11.        End If
  12.     Else                                                      '當Sheet2找不到sheet1 A欄位資料時，就在最下面新增
  13.        A2 = Sheet2.Range("A65536").End(xlUp).Row
  14.        Sheet2.Range("A" & A2) = Sheet1.Range("A" & I)
  15.        Sheet2.Range("B" & A2) = Sheet1.Range("B" & I)
  16.     End If
  17. Next
  18. End Sub
複製代碼
作者: hugh0620    時間: 2012-5-16 10:22

回復 7# waterfox

    建議您~ 資料的架構再調整一下會比較好唷~
                     資料庫的觀念~
                     每個月份的欄位都一樣~ 放在同一個SHEET~ 多加一個欄位[月份]來區別~
                     跟你區分成很多活頁來儲放資料~ 結果是一樣的~
                    但在處理上相對比較好處理一些~
作者: waterfox    時間: 2012-5-16 22:47

謝謝你的指導, 我明天會再嘗試一下.. 感激
作者: waterfox    時間: 2012-6-6 22:04

謝謝你的幫忙, 我今天終於有時間嘗試... 但有少少問題, 已附上給大大查看, 要每個月都有一個Worksheet stock list, 因為不才, 故此我會先將所有data放在sheets("Stock on hand"), 然後再將資料匯入sheets("Summary"), 但用了你的方法後,  如Column A 及Column B相同的話.. 第二行的資料便放進了隔離的月份, 但可否如column A, column B, column C and column D 要4個資料相同便在該月份column插入資料, 否則在下一行insert row, 然後插入與column A 及B 相同的資料,

其實最終的資料會放在summary sheets, 便可知道全年stock in and out movement, 謝謝你的幫忙
[attach]11288[/attach]
作者: hugh0620    時間: 2012-6-12 11:23

回復 11# waterfox


    Sorry~ 最近工作比較忙~ 所以~ 比較沒有時間上來~
    您的問題主要是將[Stock on hand]拋轉到[Summary]中~
    可試試附檔~  但是還有一個第方沒有寫唷~
    就是你在[Stock on hand] 有一個項目99 在 [Summary] 是沒有的
    因為不知道你整個操作的邏輯~ 所以~ 先完成針對將資料拋轉~
    再來一步一步的來調整~ 你所需要的~
     [attach]11347[/attach]
作者: waterfox    時間: 2012-6-18 22:05

Hugh0620, 真是很感激你的幫忙, 感激感激, 我以為冇人理我, 我已經自己用一個很大的程序去完成, 不過我會試用你幫忙編寫的附檔，由於我權限問題, 現在仍未有資格開啟壓縮檔...遲些我會再嘗試, 再次感激你啊...
作者: hugh0620    時間: 2012-6-19 09:03

回復 13# waterfox

  這是我上載檔案中的程式碼~
  1. Private Sub CommandButton1_Click()   '資料拋轉
  2. '========  A =>每一列跑的次數  ====================
  3. A = Sheet4.Range("IV2").End(xlToLeft).Column
  4. A = (A - 4) / 3
  5. If A - Int(A) > 0 Then
  6.    MsgBox "資料欄位有誤"
  7.    Exit Sub
  8. End If
  9. A = A - 1
  10. '========  B => 總共要跑的筆數  ====================
  11. B = Sheet4.Range("A65536").End(xlUp).Row

  13. For I = 3 To B
  14.     Set C = Sheet2.Columns("B:B").Find(Sheet4.Range("B" & I))
  15.    
  16.     If Not C Is Nothing Then
  17.     C = Sheet2.Columns("B:B").Find(Sheet4.Range("B" & I)).Row

  19.     For J = 0 To A    '(EX. 0->11 =12次)
  20.         D = Sheet4.Cells(I, 7 + J * 3)
  21.         If D = "" Then
  22.         Else
  23.         Do Until Sheet2.Range("F" & C + K) = ""
  24.            If Sheet2.Range("F" & C + K) = D Then
  25.               If Sheet4.Cells(I, 5 + J * 3) > 0 Then
  26.               Sheet2.Cells(C + K, 7 + J) = Sheet4.Cells(I, 5 + J * 3)
  27.               End If
  28.               If Sheet4.Cells(I, 6 + J * 3) > 0 Then
  29.               Sheet2.Cells(C + K, 21 + J) = Sheet4.Cells(I, 6 + J * 3)
  30.               End If
  31.               P = 1
  32.               Exit Do
  33.            End If
  34.            K = K + 1
  35.         Loop
  36.         If P = 0 Then
  37.            Sheet2.Rows(C + K).Insert Shift:=xlDown
  38.            Sheet2.Range("F" & C + K) = Sheet4.Cells(I, 7 + J * 3)
  39.            If Sheet4.Cells(I, 5 + J * 3) > 0 Then
  40.             Sheet2.Cells(C + K, 7 + J) = Sheet4.Cells(I, 5 + J * 3)
  41.            End If
  42.            If Sheet4.Cells(I, 6 + J * 3) > 0 Then
  43.             Sheet2.Cells(C + K, 21 + J) = Sheet4.Cells(I, 6 + J * 3)
  44.            End If
  45.         End If
  46.         End If
  47.     K = 0
  48.     P = 0
  49.     Next
  50.     End If
  51. Next

  53. End Sub
複製代碼




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