samwang

¦^´_ 1# oak0723-1

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub ¶×¾ãÀÉ®×()
Dim Arr, fs, fc, f1, fn$, xC0, xC1, R%
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False
Tm = Timer
Set fs = CreateObject("Scripting.FileSystemObject")
PH = ThisWorkbook.Path
Set f = fs.GetFolder(PH): Set fc = f.Files
For Each f1 In fc
    If InStr(f1.Name, "¶°¤¤") Then GoTo 99
    If InStr(f1.Name, "~") Then GoTo 99
    With Workbooks.Open(f1.Path)
        fn = Split(f1.Name, ".")(0)
        Arr = Sheets(1).Range("i6").CurrentRegion
        .Close
    End With
    With Sheets(1)
        R = .Range("c65536").End(3).Row + 1
        .Range("c" & R).NumberFormatLocal = "@"
        .Range("c" & R) = fn
        If xC0 = 0 Then
            xC0 = 1: xC1 = UBound(Arr, 2)
        Else
            xC0 = xC1 + 5: xC1 = xC0 + UBound(Arr, 2) - 1
        End If
        .Range("d" & R) = Replace(Cells(1, xC0).Address(0, 0), "1", "")
    End With
    Sheets(2).Cells(6, xC0).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
99: Next
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub