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

[µo°Ý] ½Ð°Ý¦³¤H¯àÀ°¦£¸Ñµª¶Ü?¨ç¼Æ¤½¦¡¸Ó¦p¦ó¼g©O?

[µo°Ý] ½Ð°Ý¦³¤H¯àÀ°¦£¸Ñµª¶Ü?¨ç¼Æ¤½¦¡¸Ó¦p¦ó¼g©O?

½Ð°Ý¦³¤H¯àÀ°¦£¸Ñµª¶Ü?¨ç¼Æ¤½¦¡¸Ó¦p¦ó¼g©O?
(¤£­n¥Î½Æ»s¶K¤W) ¦]¬°¦³¤W¤dµ§¸ê®Æªñ¦Ê¦Usheet

¦]¬°§Ú²{¦b¥u¯à¥Î½Æ»s¶K¤W,¥i¬O­nªá«Ü¦h®É¶¡§ä»P¶K

¯àÅýbook2 ¸Ìªºsheet1¦Û°Ê§ì¨ìbook1 AA¶µ¥Ø¤Î¨ä«á­±¬YÄæ¦ì¸ê®Æ
               sheet2¦Û°Ê§ì¨ìbook1 BB¶µ¥Ø¤Î¨ä«á­±¬YÄæ¦ì¸ê®Æ
                sheet3...........book1 CC.....................

§Ú¥u­n¥´¶}ÀÉ®×book2 ´N·|¦Û°Ê§ì¨úÀÉ®×book1¸ê®Æ¦Û°Ê¤ÀÃþAA BB CC¨ì¤£¦Psheet

¦]¬°ÀÉ®×book1¸Ìªºsheet1 AA BB CC  ¼Æ¥Ø¨C­Ó¤ë·|¦³©ÒÅÜ°Ê
(book1¬O§Úªº¨Ó·½®×ÀÉ)
(book2¬O§Ú·Q­nªºµ²ªG)

ÀÉ®×book1 sheet1
      A          B          C         D
1    AA        10        11        111
2    AA        20        22        222
3    AA        30        33        333
4    AA        40        44        444
5    BB        50        55        555
6    BB        60        66        666
7    CC        70        77        777
8    CC        80        88        888
9    CC        90        99        999
10   CC       100       11        111
11   CC       110       22        222
12   CC       120       33        333
13   CC       130       44        444
14   CC       140       55        555
15   CC       150       66        666


ÀÉ®×book2    sheet2
      A          B          D
1    BB        50        555
2    BB        60        666

ÀÉ®×book2    sheet1
       A         C         D
1    AA        11        111
2    AA        22        222
3    AA        33        333
4    AA        44        444

¦^´_ 1# alltest
1¡B¨Ì§^¤H©å¨£¡A±zªº¸ê®Æ¦b¥¼½s½X»P¤@¹ï¦hª¬ªp¤U(¦pAA¹ïÀ³¦hµ§¸ê®Æ)¡A µLªk³æ´N¨ç¼Æ¸Ñ¨M°ÝÃD¡C­Y¹ïraw data_§Y±z©Ò»¡ªºÀÉ®×book1 sheet1¤º¸ê®Æ¶i¦æ½s½X¡A¨Ï§e²{¤@¹ï¤@¤§ª¬ªp¡A«h¥ÎVLOOKUP§Y¥i¸Ñ¨M±zªº°ÝÃD¡C
2¡B¥HVBA©Î³\¥i¥H¸Ñ¨M¡A¤£¹L³o´N¦³½ÐVBA°ª¤â¤F¡C

TOP

¦^´_ 3# alltest
Book1ªº¤@¯ë¼Ò²Õ
  1. Sub Split_Data()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With ThisWorkbook
  4.    With .Sheets(1)
  5.       For Each a In .Range(.[A1], .[A1].End(xlDown))
  6.          If IsEmpty(d(a & "")) Then
  7.             Set d(a & "") = a.Resize(, 4)
  8.          Else
  9.             Set d(a & "") = Union(d(a & ""), a.Resize(, 4))
  10.          End If
  11.       Next
  12.       For Each ky In d.keys
  13.          Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  14.          d(ky).Copy sh.[A1]
  15.          sh.Name = ky
  16.       Next
  17.     End With
  18.    .Sheets(d.keys).Move
  19. End With
  20.      
  21. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# Hsieh


    «D±`ÁÂÁ±z~¶W¯Åª©¥DHsieh¤j¤j ªºÀ°¦£
   («D±`§Q®`! ¤@¦¸¨ì¦ì,§¹¥þ»P§Ú·Q­nªº¤@¼Ë)
   ¦¹°ÝÃD¤w¸g¸Ñ¨M~·P¿E¤£¶i^^

¦³ºa©¯¥i¥H½Ð  ¶W¯Åª©¥DHsieh¤j¤j ¦AÀ°¤@¤U¦£¶Ü?
°ÝÃD»P¦¹µo°Ý«ÜÃþ¦ü,¦ý§ó½ÆÂø¨Ç

book1¬O§Úªº¨Ó·½ÀÉ
book2¬O§Ú·Q­nªº

book1¸Ìªº¤ÀÃþ¼Æ¶q ¨C¤ë·|ÅÜ°Ê ¦Ó¦³©Ò¤£¦P

§Ú·Q¥u­n¥´¶}book2´N·|¦Û°Ê§ì¨úbook1¸Ìªº¸ê®Æ¦Û°Ê¤ÀÃþ
¨Ò¦p:book2¸Ìªº(sheet) ¶À¦â-A³¡ªù / ¶À¦â-B³¡ªù («á­±¨Ì¦¹Ãþ±À)

TOP

½Ð°Ý¦³°ª¤âÄ@·NÀ°¦£¸Ñµª¶Ü? ~ ·PÁ¤j¤j^^ (¦Û°Ê§ì¨ú¤ÀÃþ)

¥»©«³Ì«á¥Ñ alltest ©ó 2012-12-24 22:25 ½s¿è

book1¬O§Úªº¨Ó·½ÀÉ
book2¬O§Ú·Q­nªº

book1¸Ìªº¤ÀÃþ¼Æ¶q ¨C¤ë·|ÅÜ°Ê ¦Ó¦³©Ò¤£¦P

§Ú·Q¥u­n¥´¶}book2´N·|¦Û°Ê§ì¨úbook1¸Ìªº¸ê®Æ¦Û°Ê¤ÀÃþ
¨Ò¦p:book2¸Ìªº(sheet) ¶À¦â-A³¡ªù / ¶À¦â-B³¡ªù («á­±¨Ì¦¹Ãþ±À)



book.rar (21.58 KB)

TOP

¦^´_ 6# alltest
¸Õ¸Õ¬Ý
book2ªº¤@¯ë¼Ò²Õ
  1. Sub Auto_Open()
  2. Dim ary(), fs$, Sh As Worksheet
  3. Dim ay(1), Ar, Ky, s&
  4. Set d = CreateObject("Scripting.Dictionary")
  5. fs = ThisWorkbook.Path & "\book1.xls"
  6. With Workbooks.Open(fs)
  7.    With .Sheets(1)
  8.       For Each A In .Range(.[B3], .[B3].End(xlDown))
  9.       r = A.Row
  10.          For Each b In .Range(.[E1], .[IV1].End(xlToLeft).Offset(, -1)).SpecialCells(xlCellTypeConstants)
  11.          k = b.Column
  12.          Ar = Array(.Cells(r, 2).Value, .Cells(r, 3).Value, .Cells(r, 4).Value, .Cells(r, k).Value, .Cells(r, k + 1).Value, .Cells(r, k + 2).Value)
  13.          If IsEmpty(d(A & "-" & b)) Then
  14.             ay(0) = Ar
  15.             d(A & "-" & b) = ay
  16.             Else
  17.             ary = d(A & "-" & b)
  18.             s = UBound(ary)
  19.             ReDim Preserve ary(s + 1)
  20.             ary(s) = Ar
  21.             d(A & "-" & b) = ary
  22.          End If
  23.          Next
  24.         Next
  25.      End With
  26. For Each Sh In ThisWorkbook.Sheets
  27.     With Sh
  28.        .UsedRange.Offset(2) = ""
  29.        Ky = .Name
  30.        If IsArray(d(Ky)) Then
  31.        ary = d(Ky)
  32.        For i = 0 To UBound(ary) - 1
  33.          .Cells(3 + i, 1).Resize(, UBound(Ar) + 1) = ary(i)
  34.        Next
  35.        End If
  36.     End With
  37. Next
  38.      .Close 0
  39. End With
  40. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 6# alltest
¦Û°Ê¿z¿ï:
  1. Sub Ex()
  2.     Dim E As Variant, r As Integer, xi As Integer
  3.     Dim Rng(1 To 2)
  4.     With Workbooks("book1.xls").Sheets("²§±`©ú²Ó")
  5.         .AutoFilterMode = False
  6.         For Each E In Array("¶À¦â", "¬õ¦â", "«C¦â")
  7.             .Range("A2", .UsedRange.SpecialCells(xlCellTypeLastCell).Address).AutoFilter Field:=2, Criteria1:=E
  8.             xi = .Cells(Rows.Count, 2).End(xlUp).Row
  9.             For r = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 3
  10.                 Set Rng(1) = .Range("b1:d" & xi)
  11.                 Set Rng(2) = .Range(.Cells(1, r).Resize(, 3).Address & ":" & .Cells(xi, r + 2).Address)
  12.                 Set Rng(1) = Union(Rng(1), Rng(2))
  13.                 With Workbooks("book2.xls").Sheets(E & "-" & .Cells(1, r))
  14.                     .Cells.Clear
  15.                     Rng(1).Copy .[A1]
  16.                 End With
  17.             Next
  18.         Next
  19.         .AutoFilterMode = False
  20.     End With
  21. End Sub
½Æ»s¥N½X
  1. Sub Ex1() '·s¼W¬¡­¶Ã¯
  2.     Dim E As Variant, r As Integer, xi As Integer
  3.     Dim Rng(1 To 2), Wb As Workbook
  4.     Set Wb = Workbooks.Add(1)                                           '·s¼W¬¡­¶Ã¯
  5.     With Workbooks("book1.xls").Sheets("²§±`©ú²Ó")
  6.         .AutoFilterMode = False
  7.         For Each E In Array("¶À¦â", "¬õ¦â", "«C¦â")
  8.             .Range("A2", .UsedRange.SpecialCells(xlCellTypeLastCell).Address).AutoFilter Field:=2, Criteria1:=E
  9.             xi = .Cells(Rows.Count, 2).End(xlUp).Row
  10.             For r = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 3
  11.                 Set Rng(1) = .Range("b1:d" & xi)
  12.                 Set Rng(2) = .Range(.Cells(1, r).Resize(, 3).Address & ":" & .Cells(xi, r + 2).Address)
  13.                 Set Rng(1) = Union(Rng(1), Rng(2))
  14.                 Wb.Sheets.Add(, Sheets(Sheets.Count)).Name = E & "-" & .Cells(1, r) '·s¼W¤u§@ªí:©R¦W
  15.                 Rng(1).Copy ActiveSheet.[A1]
  16.             Next
  17.         Next
  18.         .AutoFilterMode = False
  19.     End With
  20. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ alltest ©ó 2012-12-25 21:57 ½s¿è

¦^´_ 7# Hsieh


   ÁÂÁ±z~¶W¯Åª©¥D Hsieh¤j¤jªº¼ö¤ßÀ°¦£ *^_^*

   ¸ò§Ú·Q­nªº¤@¼Ò¤@¼Ë­C.....YA!~
   
  (±z¯uªº¦n±j³á!~¦A¦¸ÁÂÁ±z~~)

TOP

¦^´_ 8# GBKEE


    ÁÂÁ±z~ ª©¥D GBKEE¤j¤jªº¼ö¤ßÀ°¦£¸Ñµª( «D±`·PÁÂ)...*^_^*

    ¤£¦n·N«ä~(¦]¬°§Ú¤£·|VB/VBA~sorry!!)
    ©Ò¥H·Q½Ð°Ýª©¥D GBKEE¤j¤j~

    §ÚÀ³¸Ó§âµ{¦¡©ñ¦bbook1 ©ÎªÌ¬O book2
   ¬O¤À¦¨2­Ó¼Ò²Õ ©Î¬O ©ñ¦b¦P¤@­Ó¼Ò²Õ
   µM«á°õ¦æ¥¨¶°©O?

TOP

¦^´_ 10# alltest
Ex ©ñ­þ¸Ì³£¥i¥H
Ex1 (·s¼W¬¡­¶Ã¯)»Ý©ñ¦bbook1.xls ©Î¥H¦sÀɪº¬¡­¶Ã¯¤¤

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD