[發問] 相同格式的2個工作表合成一個(相異資料新增)

pitera88

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

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

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

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

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

感恩!!

Hsieh

回復 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

複製代碼

整理.rar (12.03 KB)

下載次數: 6

2012-3-23 21:21

pitera88

回復 2# Hsieh


    收下了，感恩!!

把我的資料套上去用看看，

pitera88

回復 2# Hsieh


    版主安安

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

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

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

感恩!!! 整理.rar (12.15 KB)

下載次數: 3

2012-3-24 14:02

Hsieh

回復 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

回復 5# Hsieh


    ok了

感謝 Hsieh 大大