GBKEE

¦^´_ 2# luhpro
­×§ï§Aªºµ{§Ç½Ð°Ñ¦Ò°Ñ¦Ò

1. Sub Ex()
   
2.     Dim Ar(), S As Integer, sPath As String, sFName As String
   
3.     ReDim Ar(1, S)
   
4.     sPath = ThisWorkbook.Path    ' «ü©w¸ô®|¬°¥»ÀɮשҦbªºªº¥Ø¿ý
   
5.     sFName = Dir(sPath & "\*.xls")   ' §ä´M²Ä¤@­ÓExcelÀÉ®×
   
6.     Do While sFName <> ""    ' °õ¦æ°j°é¡C
   
7.         If sFName <> ThisWorkbook.Name Then  ' ¶}±Ò¥»ÀÉ®×¥H¥~ªºÀÉ®×
   
8.             ReDim Preserve Ar(1, S)
   
9.             With Workbooks.Open(sPath & "\" & sFName) ' ¶}ÀÉ
   
10.                 With .Sheets(1).Cells.Find("Á`¥­§¡")
    
11.                     Ar(0, S) = Mid(sFName, 1, InStrRev(sFName, ".") - 1)
    
12.                     Ar(1, S) = Cells(1, 2)
    
13.                 End With
    
14.                 .Close
    
15.             End With
    
16.             S = S + 1
    
17.         End If
    
18.         sFName = Dir    ' ´M§ä¤U¤@­ÓÀÉ®×
    
19.     Loop
    
20.     Range("A:C") = ""
    
21.     Range("A1:C1") = Array("±Æ¦W", "¤H¦W", "Á`¥­§¡")
    
22.     Range("B2").Resize(S, 2) = Ar
    
23.     Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes
    
24.     With Range("A2:A" & Range("B2").End(xlDown).Row)
    
25.         .Value = "ROW()-1"
    
26.         .Value = .Value
    
27.     End With
    
28.   If S = 0 Then
    
29.     MsgBox ("§ä¤£¨ì¥ô¦ó¸ê®ÆÀÉ®×...")
    
30.   Else
    
31.     MsgBox ("¸ê®ÆŪ¨ú§¹¦¨, ¦@Ū¨ú " & S - 1 & " ­ÓÀÉ®×...")
    
32.   End If
    
33. End Sub

½Æ»s¥N½X