GBKEE

¦^´_ 2# citizen0923
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh As Worksheet, xlWord As String, Ar(), xAr(), i As Integer, x As Integer
   
4.     xlWord = Sheets("¬d¸ß").Range("B1")  '­n¬d¸ßªº½s¸¹
   
5.     For Each Sh In Sheets                'Sheets: ¬¡­¶Ã¯ªº¤u§@ªíª«¥ó¶°¦X
   
6.         If Sh.Name <> "¬d¸ß" Then
   
7.             Ar = Sh.UsedRange.Value      'UsedRange(¤Gºû°}¦C): ¤u§@ªí¨Ï¥Îªº½d³ò
   
8.             For i = 1 To UBound(Ar)
   
9.                 If UCase(Ar(i, 1)) = UCase(xlWord) Then
   
10.                     ReDim Preserve xAr(x) '­«¸m°}¦C¤¸¯Àªº¯Á¤Þ­È,Preserve:«O¯d­ì¦³ªº¤¸¯À
    
11.                     xAr(x) = Application.Index(Ar, i)  'Ū¨ú¤Gºû°}¦C¤¤¤¸¯À
    
12.                     x = x + 1
    
13.                 End If
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     With Sheets("¬d¸ß").UsedRange.Offset(4) '³o½d³ò¤U²¾4¦Cªº½d³ò
    
18.         .Value = ""
    
19.         If x > 0 Then
    
20.             .Cells(1).Resize(x, UBound(Ar, 2)) = Application.Transpose(Application.Transpose(xAr))
    
21.             Application.Transpose'Âà¸m¨ç¼Æ
    
22.         End If
    
23.         MsgBox "¬d¸ß " & IIf(x = 0, "¤£¨ì ", "") & xlWord & IIf(x > 0, " OK!", "")
    
24.     End With
    
25. End Sub

½Æ»s¥N½X