GBKEE

¦^´_ 1# s13030029

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 2) As Range, xRow As Integer, AR, i As Integer, xI As Integer
   
4.     With Sheets("¤u§@ªí1")
   
5.         xRow = .[A9].End(xlDown).Row
   
6.         With .Range("$E$9:$G" & xRow)
   
7.             .AutoFilter
   
8.             .AutoFilter Field:=1, Criteria1:="=¥Øµø", Operator:=xlOr, Criteria2:="=´å¼Ð¥d¤Ø"
   
9.             '***¿z¿ï«áAÄæ¨ìGÄ檺¸ê®Æ°Ï°ì******
   
10.             Set Rng(1) = .Parent.Range("A10:G" & xRow).SpecialCells(xlCellTypeVisible)
    
11.             '*********************************
    
12.             Set Rng(2) = Sheets("¤u§@ªí3").[A13]
    
13.             For i = 1 To Rng(1).Areas.Count                 '**¿z¿ï«á¸ê®Æ ¤£¤@©w¬O³sÄòªº
    
14.                 For xI = 1 To Rng(1).Areas(i).Rows.Count    ''**¿z¿ï«á¸ê®Æªº Areas ¶°¦X¡A¦¹¶°¦X¥Nªí¦h°Ï°ì¿ï¨ú½d³ò¤¤ªº©Ò¦³½d³ò¡C
    
15.                     AR = Application.Transpose(Application.Transpose(Rng(1).Areas(i).Rows(xI)))
    
16.                     'Rng(1).Areas(i).Rows(xI) Âà´«¦¨¤@ºû°}¦C
    
17.                     
    
18.                     '***³B²z ¿z¿ï«áAÄæ¨ìGÄ檺¸ê®Æ°Ï°ì  ¤¤¦³¨S¦³¸ê®ÆªºÄæ¦ì******
    
19.                     AR = Join(AR, ",")  '°}¦C¥H","³sµ²Âର¤å¦r
    
20.                     Do While InStr(AR, ",,")
    
21.                         AR = Replace(AR, ",,", ",")  ' ** ®ø°£¦h¾lªº","  '
    
22.                     Loop
    
23.                     AR = Split(Mid(AR, 1, Len(AR) - 1), ",")  '¤å¦r¥H","Âର°}¦C
    
24.                     With Rng(2)
    
25.                         .Cells(1) = AR(0)
    
26.                         .Cells(1, 2) = AR(1) & vbLf & AR(2)
    
27.                         EX_®æ¦¡ .Cells(1).Resize(5)
    
28.                         EX_®æ¦¡ .Cells(1, 2).Resize(5)
    
29.                     End With
    
30.                     Set Rng(2) = Rng(2).Offset(1)
    
31.                 Next
    
32.            Next
    
33.         End With
    
34.     End With
    
35. End Sub
    
36. Sub EX_®æ¦¡(ByVal Target As Range)
    
37.     With Target
    
38.         .HorizontalAlignment = xlCenter
    
39.         .VerticalAlignment = xlCenter
    
40.         .WrapText = False
    
41.         .Orientation = 0
    
42.         .AddIndent = False
    
43.         .IndentLevel = 0
    
44.         .ShrinkToFit = False
    
45.         .ReadingOrder = xlContext
    
46.         '.MergeCells = True
    
47.          .Merge
    
48.     End With
    
49. End Sub

½Æ»s¥N½X