Hsieh

¦^´_ 1# amychlo

±Nµ{¦¡½X©ñ¦b·J¾ãªº¬¡­¶Ã¯¤@¯ë¼Ò²Õ

1. Sub ·J¾ã()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. fd = ThisWorkbook.Path & "\" '3­ÓÀɮשñ¦b¦P¥Ø¿ý¤¤
   
4. 'fd="D:\"  '«ü©wA¡BB2Àɮתº¦s©ñ¥Ø¿ý
   
5. fs = Array("A.xls", "B.xls")
   
6. d("³W®æ") = "¼Æ¶q"
   
7. For Each f In fs
   
8.    With Workbooks.Open(fd & f)
   
9.       With .Sheets(1)
   
10.       i = i + 1
    
11.       .UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
    
12.       With ThisWorkbook.Sheets(i)
    
13.           For Each a In .Range(.[A2], .[A2].End(xlDown))
    
14.              If IsEmpty(d(a.Value)) Then d(a.Value) = a.Offset(, 1) Else d(a.Value) = a.Offset(, 1) - d(a.Value)
    
15.           Next
    
16.       End With
    
17.       End With
    
18.       .Close
    
19.     End With
    
20. Next
    
21. With Sheets(3)
    
22.    .[A1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
23.    .[B1].Resize(d.Count, 1) = Application.Transpose(d.items)
    
24. End With
    
25. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# amychlo
¬Q¤Ñ¦]¬°½×¾ÂªººÏºÐ°}¦C¥X°ÝÃD¡A¿ò¥¢¤F¸ê®Æ¡A­«·s¦^´_

1. Sub ·J¾ã()
   
2. Dim Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. fd = ThisWorkbook.Path & "\" '3­ÓÀɮשñ¦b¦P¥Ø¿ý¤¤
   
5. 'fd="D:\"  '«ü©wA¡BB2Àɮתº¦s©ñ¥Ø¿ý
   
6. fs = Array("A.xls", "B.xls")
   
7. d("³W®æ") = "¼Æ¶q"
   
8. For Each f In fs
   
9.    With Workbooks.Open(fd & f)
   
10.       With .Sheets(1)
    
11.       i = i + 1
    
12.       ReDim Preserve Ar(2, s)
    
13.       Ar(0, s) = "³W®æ": Ar(1, s) = "¼Æ¶q"
    
14.       s = s + 1
    
15.       .UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
    
16.       With ThisWorkbook.Sheets(i)
    
17.           For Each a In .Range(.[B2], .[B2].End(xlDown))
    
18.              If IsEmpty(d(Right(a, 2))) Then d(Right(a, 2)) = a.Offset(, IIf(i = 1, 3, 2)) Else d(Right(a, 2)) = a.Offset(, IIf(i = 1, 3, 2)) - d(Right(a, 2))
    
19.              ReDim Preserve Ar(2, s)
    
20.              Ar(0, s) = Right(a, 2): Ar(1, s) = a.Offset(, IIf(i = 1, 3, 2)).Value
    
21.              s = s + 1
    
22.           Next
    
23.           Sheets(3).[A1].Offset(, (i - 1) * 2).Resize(s, 2) = Application.Transpose(Ar)
    
24.           Erase Ar: s = 0
    
25.       End With
    
26.       End With
    
27.       .Close
    
28.     End With
    
29. Next
    
30. With Sheets(3)
    
31.    .[E1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
32.    .[F1].Resize(d.Count, 1) = Application.Transpose(d.items)
    
33. End With
    
34. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 7# amychlo
¸Õ¸Õ¬Ý

1. Sub ·J¾ã()
   
2. Dim Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. fd = ThisWorkbook.Path & "\" '3­ÓÀɮשñ¦b¦P¥Ø¿ý¤¤
   
5. 'fd="D:\"  '«ü©wA¡BB2Àɮתº¦s©ñ¥Ø¿ý
   
6. fs = Array("A.xls", "B.xls")
   
7. d("³W®æ") = "¼Æ¶q"
   
8. For Each f In fs
   
9.    With Workbooks.Open(fd & f)
   
10.       With .Sheets(1)
    
11.       i = i + 1
    
12.       ReDim Preserve Ar(2, s)
    
13.       Ar(0, s) = "³W®æ": Ar(1, s) = "¼Æ¶q"
    
14.       s = s + 1
    
15.       .UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
    
16.       With ThisWorkbook.Sheets(i)
    
17.           For Each a In .Range(.[B2], .[B2].End(xlDown))
    
18.           mystr = Mid(a, 1 / (i / 2))
    
19.              If IsEmpty(d(mystr)) Then d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) Else d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) - d(mystr)
    
20.              ReDim Preserve Ar(2, s)
    
21.              Ar(0, s) = mystr: Ar(1, s) = a.Offset(, IIf(i = 1, 7, 2)).Value
    
22.              s = s + 1
    
23.           Next
    
24.           Sheets(3).[A1].Offset(, (i - 1) * 2).Resize(s, 2) = Application.Transpose(Ar)
    
25.           Erase Ar: s = 0
    
26.       End With
    
27.       End With
    
28.       .Close 0
    
29.     End With
    
30. Next
    
31. With Sheets(3)
    
32.    .[E1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
33.    .[F1].Resize(d.Count, 1) = Application.Transpose(d.items)
    
34. End With
    
35. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# amychlo

³o¥y¬O±N°}¦C¼g¤J¤u§@ªí
¦¹¥y·|µo¥Í¶W¥X°}¦C¯Á¤Þ¿ù»~¥u¥i¯àµo¥Í¦bSheets(3)
¦³¥i¯à§Aªº¬¡­¶Ã¯¨Ã¨S¦³3­Ó¥H¤Wªº¤u§@ªí¦s¦b

Hsieh

¦^´_ 11# amychlo

³o¼Ë´N«ÜÃø§PÂ_¿ù»~¥X¦b­þ¸Ì
¥[¤J©³¤U¬õ¦r³¡¤À¬Ý¬Ý
¦pªGÁÙ¤£¦æ³Ì¦n±N3ÀɮפW¶Ç´ú¸Õ¬Ý¬Ý
Sub ·J¾ã()
Dim Ar()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '3­ÓÀɮשñ¦b¦P¥Ø¿ý¤¤
'fd="D:\"  '«ü©wA¡BB2Àɮתº¦s©ñ¥Ø¿ý
fs = Array("A.xls", "B.xls")
d("³W®æ") = "¼Æ¶q"
For Each f In fs
   With Workbooks.Open(fd & f)
      With .Sheets(1)
      i = i + 1
      ReDim Preserve Ar(2, s)
      Ar(0, s) = "³W®æ": Ar(1, s) = "¼Æ¶q"
      s = s + 1
      .UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
      With ThisWorkbook.Sheets(i)
          For Each a In .Range(.[B2], .[B2].End(xlDown))
          mystr = Mid(a, 1 / (i / 2))
             If IsEmpty(d(mystr)) Then d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) Else d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) - d(mystr)
             ReDim Preserve Ar(2, s)
             Ar(0, s) = mystr: Ar(1, s) = a.Offset(, IIf(i = 1, 7, 2)).Value
             s = s + 1
          Next
          ThisWorkbook.Sheets(3).[A1].Offset(, (i - 1) * 2).Resize(s, 2) = Application.Transpose(Ar)
          Erase Ar: s = 0
      End With
      End With
      .Close 0
    End With
Next
With Sheets(3)
   .[E1].Resize(d.Count, 1) = Application.Transpose(d.keys)
   .[F1].Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

Hsieh

¦^´_ 13# amychlo
³o­ì¦]´N¥X²{¦b¦]¬°¶}±Ò¨Ó·½Àɮ׫á§@¥Îµøµ¡Åܦ¨¨Ó·½ÀÉ®×
¥¼«ü©w¬¡­¶Ã¯ªº¤u§@ªí´N·|«ü¦V¸Ó°µ¥Î¤¤¬¡­¶Ã¯
©Ò¥H·íA©ÎBÀɮרS¦³²Ä3±i¤u§@ªí®É§Y·|¥X²{¦¹¿ù»~