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

½Ð°Ý¸Ó¦p¦ó¨Ï¥Î±Æ§Ç¨Ã±N»Ý­n¸ê®Æ±a¥X¦Üsheet2

½Ð°Ý¸Ó¦p¦ó¨Ï¥Î±Æ§Ç¨Ã±N»Ý­n¸ê®Æ±a¥X¦Üsheet2

½Ð°Ý¸Ó¦p¦ó¨Ï¥Î±Æ§Ç¨Ã±N»Ý­n¸ê®Æ±a¥X¦Üsheet2
¨Ò¦p¡GD07-01
        D07-02
        D07-03
        D08-01
        D08-02
        D08-03

½Æ¥» TEST-Charge.rar (4.65 KB)

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-6-8 16:44 ½s¿è

¦^´_ 1# yueh0720
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar(), xl As Integer
  4.     With Sheets(1)                              '²Ä1­Ó¤u§@ªí
  5.         .AutoFilterMode = False                 '¨ú®ø ³o¤u§@ªíªº¦Û°Ê¿z¿ï
  6.         Ar = .Range("A1").CurrentRegion.Value   '¸ê®ÆÂà¤J°}¦C
  7.          .Range("A1").CurrentRegion.Sort Key1:=.Range("H2"), Order1:=xlAscending, Key2:=.Range( _
  8.             "A2"), Order2:=xlAscending, Header:=xlYes                     '±Æ§Ç
  9.          .Range("IV:IV") = ""                   '²M°£IVÄæ¸ê®Æ
  10.          .Columns("H:H").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("IV1"), CriteriaRange:=.Range("IU1:IU2"), Unique:=True
  11.                                                 'AdvancedFilter ¶i¶¥¿z¿ï: HÄ椣­«½Æ¸ê®Æ  ¿z¿ï¨ì.Range("IV1")
  12.         xl = 2                                  '±q ²Ä2¦C ¶}©l
  13.         Do While .Range("IV" & xl) <> ""        '±ø¥ó¦¨¥ß: °õ¦æ°j°é
  14.             If Sheets.Count < xl Then Sheets.Add , Sheets(Sheets.Count)  '¤u§@ªí¼Æ¤p©óxl:·s¼W¤u§@ªí
  15.             .Range("A1").AutoFilter Field:=8, Criteria1:=.Range("IV" & xl)      '¦Û°Ê¿z¿ï: ²Ä8Äæ=.Range("IV" & xl)
  16.             .Range("A1").CurrentRegion.SpecialCells(xlCellTypeConstants).Copy Sheets(xl).[A1] '¿z¿ï¨ìªº¸ê®Æ:½Æ»s¨ì «ü©w¤u§@ªíªº[A1]
  17.             xl = xl + 1                         '±q²Ä2¦C: ©¹¤U¤@¦C
  18.         Loop
  19.         .AutoFilterMode = False
  20.          .Range("A1").CurrentRegion.Value = Ar  '¨ú¥X°}¦C¸ê®Æ ¸m¦^
  21.     End With
  22. End Sub
½Æ»s¥N½X

TOP

¦^´_ 1# yueh0720
  1. Sub xx()
  2. Dim Ar(1 To 1000, 1 To 10)
  3. Sheets(1).Select
  4. Br = Array("", "", "Discharge", "charge")
  5. For Sh = 2 To 3
  6.   Set d = CreateObject("scripting.dictionary")
  7.   [A1].Sort Key1:=[A1], Order1:=xlAscending, Header:=xlGuess
  8.   [A1].AutoFilter Field:=8, Criteria1:=Br(Sh)
  9.   I = 0
  10.   For Each A In Range("A2:A" & [A1].End(xlDown).Row).SpecialCells(xlCellTypeVisible)
  11.     If Not d.exists(A.Value) Then
  12.        I = I + 1: J = 1
  13.        d(A.Value) = A.Offset(0, 1)
  14.        Ar(I, J) = A.Offset(0, 17)
  15.     Else
  16.        J = J + 1
  17.        Ar(I, J) = A.Offset(0, 17)
  18.     End If
  19.   Next
  20. Sheets(Sh).Cells = ""
  21. Sheets(Sh).[A1:M1] = Array("Dock-Ch", "Serial No", "Action", 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  22. Sheets(Sh).[A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
  23. Sheets(Sh).[B2].Resize(d.Count, 1) = Application.Transpose(d.items)
  24. Sheets(Sh).[C2].Resize(d.Count, 1) = Br(Sh)
  25. Sheets(Sh).[D2].Resize(d.Count, 2) = Ar
  26. Set d = Nothing: Erase Ar
  27. Next Sh
  28. Sheets(1).AutoFilterMode = False
  29. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §Ú­Ì­n°µ¦nªÀ·|ªºÀô«O¡A¤]­n°µ¦n¤º¤ßªºÀô«O¡C
ªð¦^¦Cªí ¤W¤@¥DÃD