ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-6-19 23:14 ½s¿è

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

¥»©«³Ì«á¥Ñ GBKEE ©ó 2010-6-21 07:44 ½s¿è

¦^´_ 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

TOP

[ª©¥DºÞ²z¯d¨¥]
  • Hsieh(2010-6-21 15:55): ¾Ç²ß«ç·|¬O¥áÁyªº¨Æ©O? ¤j®a³£¬O¤¬¬Û¾Ç²ß¦¨ªøªº


·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ªº¹ê¨Ò¤¤¾Ç²ß !!!    """ ®Ñ¨ì¥Î®É¤è«ë¤Ö"

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-6-21 15:56 ½s¿è

¦^´_ 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)
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

[ª©¥DºÞ²z¯d¨¥]
  • Hsieh(2010-6-23 18:01): ¥u­n½Æ»s¥N½X¥h¥Î´N¥i¥H¤F

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

TOP

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

TOP

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

TOP

        ÀR«ä¦Û¦b : ®É®É¦n¤ß´N¬O®É®É¦n¤é¡C
ªð¦^¦Cªí ¤W¤@¥DÃD