Board logo

標題: [發問] 相同格式的2個工作表合成一個(相異資料新增) [打印本頁]
作者: pitera88    時間: 2012-3-23 15:27     標題: 相同格式的2個工作表合成一個(相異資料新增)

請問我有2個工作表，格式都是 姓名 身份證字號 生日 地址

現在a工作表是舊的資料  b工作表是新的資料(也有些是舊資料)，也就是2個工作表有一些相同的資料

我想從2個工作表中重整資料，a的工作表作母工作表，從b工作表更新及新增資料(以身份證字號為基準)

以前都是轉到 access 去作，不知在excel中怎麼操作?

((另建一個新工作表也ok))

感恩!!
作者: Hsieh    時間: 2012-3-23 21:21

回復 1# pitera88
VBA輔助比較簡單
  1. Private Sub CommandButton1_Click()
  2. Dim Sh As Worksheet
  3. Set d = CreateObject("Scripting.Dictionary")
  4. For Each Sh In Sheets(Array("A", "B"))
  5.    With Sh
  6.       For Each a In .Range(.[B2], .[B2].End(xlDown))
  7.          d(a.Value) = a.Offset(, -1).Resize(, 4).Value
  8.       Next
  9.     End With
  10. Next
  11. With Sheets(3)
  12. .UsedRange.Offset(1).ClearContents
  13. .[A2].Resize(d.Count, 4).Value = Application.Transpose(Application.Transpose(d.items))
  14. .[A2].Resize(d.Count, 4).Sort key1:=.Cells(1, 1), Header:=xlNo
  15. End With
  16. End Sub
複製代碼
[attach]10115[/attach]
作者: pitera88    時間: 2012-3-24 13:11

回復 2# Hsieh


    收下了，感恩!!

把我的資料套上去用看看，
作者: pitera88    時間: 2012-3-24 14:02

回復 2# Hsieh


    版主安安

把程式套用到資料裏面是ok的

但~~~我忘了!!裏面還有一個是電話欄，我是用文字的格式存的，整合後的格式是「通用」，資料就亂掉了。請問可以連格式都複製嗎? ((我試過先去「結果」那把格式改成「文字」，再整合一次就ok了，所以這部份，如果麻煩的話，就不用了))

比較重要的是，原來的「A」資料，有另2個欄位 是「B」資料裏沒有的，可以保留「A」資料的這2個欄位整合過去嗎?

感恩!!! [attach]10126[/attach]
作者: Hsieh    時間: 2012-3-24 14:55

回復 4# pitera88

B工作表有資料就寫入B工作表，沒有的就以A工作表為準
  1. Private Sub CommandButton1_Click()
  2. Dim Sh As Worksheet, A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. For Each Sh In Sheets(Array("A", "B"))
  5.    With Sh
  6.       For Each A In .Range(.[B2], .[B2].End(xlDown))
  7.          If IsEmpty(d(A.Value)) Then
  8.             d(A.Value) = Application.Transpose(Application.Transpose(A.Offset(, -1).Resize(, 7).Value))
  9.             Else
  10.             ar = d(A.Value)
  11.             For i = LBound(ar) To UBound(ar)
  12.               If A.Offset(, -1).Resize(, 7).Cells(1, i) <> "" Then ar(i) = A.Offset(, -1).Resize(, 7).Cells(1, i).Value
  13.               d(A.Value) = ar
  14.             Next
  15.             End If
  16.       Next
  17.     End With
  18. Next
  19. With Sheets(3)
  20. .UsedRange.Offset(1).ClearContents
  21. .[A2].Resize(d.Count, 7).Value = Application.Transpose(Application.Transpose(d.items))
  22. .[A2].Resize(d.Count, 7).Sort key1:=.Cells(1, 1), Header:=xlNo
  23. End With
  24. End Sub
複製代碼
作者: pitera88    時間: 2012-3-24 15:24

回復 5# Hsieh


    ok了

感謝 Hsieh 大大



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