[µo°Ý] ¤ñ¸û¸ê®Æ-§Q¥ÎVBAµ{¦¡¤ñ¸û¨â­Ó¸ê®ÆÀɮרðµ­pºâ

amychlo

³Â·Ð¦U¦ì¤j¤j¡G
¥H¤U¤£ª¾¦³½Ö·|©O¡H¥i¥H±Ð§Ú¶Ü¡H
ÀÉ®×A
³W®æ  ¼Æ¶q
AAA  20
BBB   35
CCC  42
DDD 10
ÀÉ®×B
³W®æ  ¼Æ¶q
AAA  20
BBB   30
CCC  46
DDD 10
´N¬O¦³¨â­ÓÀɮפº®e¤À§O¦p¤W¡A§Æ±æ¯à°÷«ö¤@­Ó«ö¶s¡A
1.¥ý±N¨â­ÓÀɮפÀ§O©ñ¦b¦P¤@Àɮפ£¦Pªº¤u§@ªí
2.¦A±N¤ñ¸ûµ²ªG©ñ¦b²Ä¤T­Ó¤u§@ªí¡AÅã¥Ü¦p¤U¡G
³W®æ  ¼Æ¶q    ³W®æ  ¼Æ¶q    ³W®æ  ®t²§¼Æ
AAA  20       AAA  20       AAA       0
BBB   30       BBB   35       BBB        5  (Àx¦s®æ¥Î¬õ¦âÅã¥Ü)
CCC  42       CCC  46       CCC     -6  (Àx¦s®æ¥Î¬õ¦âÅã¥Ü)
DDD 10       DDD 10       DDD      0

Hsieh

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

amychlo

¦^´_ 12# Hsieh
¤j¤j¡G·P®¦§A¡I
¥Ø«e´ú¸Õ¦¨¥\¡C
´N¦p§A©Ò¥[ªº¤@¼Ë¡AOK¤F¡I

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

amychlo

¦^´_ 10# Hsieh
¤j¤j¡G
§Úªº¤u§@ªí¬O­è¦n¥u¦³¤T±i¤u§@ªí¡A
¨S¦³²Ä¥|±i¡C

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

amychlo

¦^´_ 8# Hsieh

¤j¤j¡G·P®¦±z¡I
¤j­P¤W¬O¥i¥H¤F¡A
¦ý¬O°õ¦æ®Éµo¥Í
[°õ¦æ¶¥¬q¿ù»~'9'
°}¦C¯Á¤Þ¶W¥X½d³ò]
¦A«ö(°»¿ù)«á
´Nµo²{¼Ò²Õµ{¦¡«ü¦V²Ä24¦C¡A
©Ò¥H¤£ª¾¹D³o¤@¦C¬O¦³¤°»ò¥Î³~©O¡H
³Â·Ð±zÅo¡I·P®¦

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

amychlo

¦^´_ 6# Hsieh

¤j¤j¡G
·P®¦±zªº¦^´_¡I
¦ý§Ú¸Õ¤F´X¤ÑÁÙ¬O§ï¤£¥X§Ú­nªºª¬ªp¡A
©Ò¥H²{¦b´N§â§Úªº­ì©lÀÉÀ£ÁY¤W¶Ç¡A
¦A³Â·Ð±z¬Ý¬Ý¡I
·P®¦¡I
A.rar (6.78 KB)

¤U¸ü¦¸¼Æ: 9

2013-3-16 19:14

      B.rar (4.78 KB)

¤U¸ü¦¸¼Æ: 8

2013-3-16 19:14

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