[µo°Ý] ¦p¦ó±N¤£¦P¤u§@ªíªº¤ºªí³æ¸ê®Æ¶×Á`¨ì¦P¤@¤u§@ªí¤º

wendy

¦p¦ó±N¤£¦P¤u§@ªíªº¤ºªí³æ¸ê®Æ¶×Á`¨ì¦P¤@¤u§@ªí¤º, ¥B¶×Á`¤u§@ªíªºÄæ¦ì¥i¯à»P¨Ó·½¬O¤£¬Û¹ïÀ³Äæ
±ÄÁʻݨD²Î­pªí.rar (33.66 KB)

¤U¸ü¦¸¼Æ: 21

2010-6-19 23:14

GBKEE

¦^´_ 1# wendy
¸Õ¸Õ¬Ý

1. Sub Ex()
   
2.     Dim Sh As Worksheet, R As Range, C As Range, S$, d(1 To 3) As Object, Ar
   
3.     Set d(1) = CreateObject("scripting.dictionary")
   
4.     Set d(2) = CreateObject("scripting.dictionary")
   
5.     Set d(3) = CreateObject("scripting.dictionary")
   
6.     Ar = Join(Application.Transpose(Application.Transpose(Sheets("1").[A3:F3])), ",")
   
7.     For Each Sh In Sheets(Array("1", "2", "3", "4"))
   
8.         With Sh
   
9.             For Each R In .Range("g3", .Range("iv3").End(xlToLeft)(1, 0))
   
10.                 d(1)(R.Value) = ""
    
11.                 For Each C In .Range(R(2, 1), .Cells(.Range("F" & Rows.Count).End(xlUp).Row - 1, R.Column)).SpecialCells(xlCellTypeConstants)
    
12.                     If C <> "" Then
    
13.                         S = R.Value & Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
14.                         d(2)(S) = C.Value
    
15.                         S = Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
16.                         d(3)(S) = .Cells(C.Row, "A").Cells.Resize(1, 6).Value
    
17.                     End If
    
18.                 Next
    
19.             Next
    
20.         End With
    
21.     Next
    
22.     With Sheets("­n¶×¾ãªºÁ`ªí")
    
23.         .Cells.Clear
    
24.         Ar = Split(Ar & "," & Join(d(1).keys, ","), ",")
    
25.         .[A1].Resize(, UBound(Ar) + 1) = Ar
    
26.         .[A2].Resize(d(3).Count, 6) = Application.Transpose(Application.Transpose(d(3).items))
    
27.         For Each R In .Range("a1").CurrentRegion.Columns
    
28.             If R.Column > 6 Then
    
29.                 For Each C In R.Cells
    
30.                     S = R.Cells(1) & Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
31.                     If d(2).Exists(S) Then C = d(2)(S)
    
32.                 Next
    
33.             End If
    
34.         Next
    
35.         .Range("a1").CurrentRegion.Sort KEY1:=.[A1], KEY2:=.[F1], Header:=xlYes
    
36.         
    
37.         Set R = .Range("a1").CurrentRegion
    
38.         Set R = .Range("a1").CurrentRegion.Cells(R.Rows.Count, R.Columns.Count)
    
39.         
    
40.         .Cells(R.Row + 1, "F") = "Á`­p"
    
41.         .Range(.Cells(R.Row + 1, "G"), R.Offset(1)) = "=SUM(R2C:R[-1]C)"
    
42.         .Range(.Cells(R.Row + 1, "G"), R.Offset(1)).Value = .Range(.Cells(R.Row + 1, "G"), R.Offset(1)).Value
    
43.         
    
44.         .Cells(1, R.Column + 1) = "Á`­p"
    
45.         .Range(.Cells(2, R.Column + 1), R.Offset(, 1)) = "=SUM(RC7:RC[-1])"
    
46.         .Range(.Cells(2, R.Column + 1), R.Offset(, 1)).Value = .Range(.Cells(2, R.Column + 1), R.Offset(, 1)).Value
    
47.     End With
    
48. End Sub

½Æ»s¥N½X

wendy

·P®¦,,   §Ú¥ý¸Õ¸Õ, ¦ý¦n¥áÁyªº¬O,¨S¦³¾Ç¹L¥ô¦óµ{¦¡³]­p, ©Ò¥H­nª½±µ®M¥Î«á,, ¦AºCºC©¹¦^¬ã¨s, ¦³¤H¥i¥Hª½±µ±Ð±Â´N¤Ó¦n¤F!!  excel ¨ç¼Æ§Ú¬O¥i¥H±q " ? " ¤¤¦Û¾Ç,  ©Ò¥H§Ú§V¤Oªº¦bª§¨ú¿n¤À, ¤~¥i¥H±q§O¤Hªº¹ê¨Ò¤¤¾Ç²ß !!!    """ ®Ñ¨ì¥Î®É¤è«ë¤Ö"

Hsieh

¦^´_ 3# wendy

1. Sub Ex()
   
2. Dim MySh As Worksheets, Sh As Worksheet, MyId As Range, Ar(), Ay(), Ary(), A As Range
   
3. Dim s%, n&
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For Each Sh In Sheets(Array("1", "2", "3", "4"))
   
6.    With Sh
   
7.    Set MyId = .Cells.Find("«~¸¹", lookat:=xlWhole)
   
8.    For Each A In MyId.EntireRow.SpecialCells(xlCellTypeConstants)
   
9.      If A <> "Á`­p" And d.exists(A.Value) = False Then d(A.Value) = d.Count
   
10.    Next
    
11.    End With
    
12. Next
    
13. d("Á`­p") = d.Count
    
14. With Sheets.Add
    
15. On Error Resume Next
    
16. Application.DisplayAlerts = False
    
17. Sheets("¥Î¶q»Ý¨DÁ`ªí").Delete
    
18. .Name = "¥Î¶q»Ý¨DÁ`ªí"
    
19. .[A1].Resize(, d.Count) = d.keys
    
20. ReDim Ay(0 To d.Count)
    
21. For Each Sh In Sheets(Array("1", "2", "3", "4"))
    
22. ReDim Ar(d.Count)
    
23.    With Sh
    
24.    Set MyId = .Cells.Find("«~¸¹", lookat:=xlWhole)
    
25.    For Each A In MyId.EntireRow.SpecialCells(xlCellTypeConstants)
    
26.       Ar(s) = d(A.Value)
    
27.       s = s + 1
    
28.    Next
    
29.    For Each A In .Range(MyId, MyId.End(xlDown))
    
30.    If A <> "Á`­p" Then
    
31.       For i = 0 To d.Count
    
32.        If Ar(i) <> "" Then Ay(Ar(i)) = .Cells(A.Row, 1).Offset(, i).Value
    
33.       Next
    
34.    ReDim Preserve Ary(n)
    
35.    Ary(n) = Ay
    
36.    n = n + 1
    
37.    End If
    
38.    ReDim Ay(0 To d.Count)
    
39.    Next
    
40.    End With
    
41.     s = 0
    
42. Next
    
43. .[A1].Resize(n, d.Count) = Application.Transpose(Application.Transpose(Ary))
    
44. .Cells.EntireColumn.AutoFit
    
45. ActiveWindow.Zoom = 75
    
46. End With
    
47. Application.DisplayAlerts = True
    
48. End Sub

½Æ»s¥N½X

§â¤Àªí·J¾ã¦¨Á`ªí
¸Õ¸Õ¤£¦Pªº«äºû
±ÄÁʻݨD²Î­pªí.rar (71.76 KB)

¤U¸ü¦¸¼Æ: 30

2010-6-21 15:52

wendy

ÁÂÁÂ¥ý½úªº¸ê®Æ,, §Ú¥ý¸Õ¸Õ,,  

HUNGCHILIN

«Øij¥ý¾Ç²ß¼Ï¯Ã¤ÀªR
¦A¦^ÀY¨Ó¬Ý¬Ý§Aªºªí
¬Û«H·|¦³§ó¦h¦¬Ã¬

wendy

ÁÂÁ«Øij,,§Ú·|¦h§V¤O,,,