samwang

¦^´_ 22# wang077


¤w±H¥X¡A½Ð½T»{¡AÁÂÁÂ

samwang

¦^´_ 25# wang077

½Ð´ú¸Õ¬Ý¬Ý¡A¥i½Æ¿ïÀɮסAÁÂÁ¡C

Sub ¿ï¾ÜÀÉ®×()
Dim Arr, WB, fc%, x%, fn$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

With Sheets("Á`ªí")
    If .FilterMode Then .ShowAllData
    .Range("a2:j" & .[a65536].End(3).Row) = ""
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "D:\"
        .AllowMultiSelect = True
        .Show
        fc = .SelectedItems.Count
        If fc = 0 Then Exit Sub
        Tm = Timer
        For x = 1 To fc
            FPath = .SelectedItems(x)
            Set WB = Workbooks.Open(FPath)
            With Sheets(1)
                If .FilterMode Then .ShowAllData
                Arr = .Range("a3:i" & .[a65536].End(3).Row)
                fn = Split(ActiveWorkbook.Name, ".")(0)
            End With
            WB.Close
        n = [a65536].End(xlUp).Row + 1
        Range("a" & n).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
        Range("j" & n & ":j" & [a65536].End(xlUp).Row) = fn
        Next
    End With
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub

samwang

¦^´_ 27# wang077

§Ú¤]¬O·s¤â¾Ç²ß¤¤¡A¼g±o¤£¦n½Ð¨£½Ì¡AÁÂÁ¡C

Sub ¿ï¾ÜÀÉ®×()
Dim Arr, WB, fc%, x%, fn$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

With Sheets("Á`ªí")
    If .FilterMode Then .ShowAllData                '¦³¿z¿ï®É¸Ñ°£¿z¿ï
    .Range("a2:j" & .[a65536].End(3).Row) = ""      '²M°£¸ê®Æ
    With Application.FileDialog(msoFileDialogOpen)  '¿ï¾Ü»Ý¨DÀÉ®×
        .InitialFileName = "D:\"                    '¹w³]D¼Ñ
        .AllowMultiSelect = True                    '¥i½Æ¿ï
        .Show                                       'µe­±Åã¥Ü
        fc = .SelectedItems.Count                   '­pºâ¿ï¾ÜÀÉ®×¼Æ
        If fc = 0 Then Exit Sub                     '¨S¿ïÀɮ׫hÂ÷¶}
        Tm = Timer                                  '¶}©l­p®É
        For x = 1 To fc
            FPath = .SelectedItems(x)               'Àɮ׸ô®|
            Set WB = Workbooks.Open(FPath)          '¶}±ÒÀÉ®×
            With Sheets(1)                          'Àɮתº²Ä1 sheet
                If .FilterMode Then .ShowAllData    '¦³¿z¿ï®É¸Ñ°£¿z¿ï
                Arr = .Range("a3:i" & .[a65536].End(3).Row)         '¨Ó·½¸Ë¤J¼Æ²Õ
                fn = Split(ActiveWorkbook.Name, ".")(0)             '¨ú±oÀɦW
            End With
            WB.Close                                                'Ãö³¬¨Ó·½ÀÉ®×
        n = [a65536].End(xlUp).Row + 1                              'Á`ªíaÄæ³Ì«á¤@µ§¸ê®Æ+1ªº¦ì¸m
        Range("a" & n).Resize(UBound(Arr), UBound(Arr, 2)) = Arr    '¨Ó·½¶K¤JÁ`ªí
        Range("j" & n & ":j" & [a65536].End(xlUp).Row) = fn         '¨Ó·½ªºÀɦW¶K¤JÁ`ªí
        Next
    End With
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub

samwang

¦^´_ 29# wang077

½Ð¦A¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test2()
Dim Arr, WB, fc%, x%, fn$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
fileorg = ActiveWorkbook.Name
n = 1
With Sheets("Á`ªí")
    If .FilterMode Then .ShowAllData
    .Range("a1:AA" & .[a65536].End(3).Row).Delete
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "D:\"
        .AllowMultiSelect = True
        .Show
        fc = .SelectedItems.Count
        If fc = 0 Then Exit Sub
        Tm = Timer
        For x = 1 To fc
            FPath = .SelectedItems(x)
            Set WB = Workbooks.Open(FPath)
            With Sheets(1)
                If .FilterMode Then .ShowAllData
                fn = Split(ActiveWorkbook.Name, ".")(0)
                .Range("a1:z" & .[a65536].End(3).Row).Copy Workbooks(fileorg).Sheets("Á`ªí").Range("a" & n)
            End With
            WB.Close
            Range("AA" & n & ":AA" & [a65536].End(xlUp).Row) = fn
            n = [a65536].End(xlUp).Row + 1
        Next
    End With
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub

samwang

¦^´_ 31# wang077 [/

±N»Ý­n½Æ»sªºÀɮשñ¦b¬Y­Ó¸ê®Æ§¨
¶}±Òªí³æ«á¿ï¨ú¨º­Ó¸ê®Æ§¨
·|¦Û°ÊÅã¥Ü¥X¨º­Ó¸ê®Æ¸ÌªºÀɮצWºÙ
¿ï¨úÀɦWµM«á½Æ»s
½Ð´ú¸Õ¬Ý¬Ý
ÁÂÁÂ

samwang

¦^´_ 35# wang077


¤w±Hµ¹±z¤F¡AÁÂÁÂ

samwang

¦^´_ 39# wang077


¦pªG¶}±Òªí³æ«á­nª½±µ§â¾÷1¡A¾÷2¥s¥X¨Ó¦bListBox¤W©O¡Aµ¥©ó¤£­n¦³¿ï¾Ü¸ê®Æ§¨³o¨BÆJ
>>  ¦]¬°­n¿ï¨ú¸ê®Æ§¨¤~¯à±oª¾¦³­þ¨ÇÀɮסA¤£µMµLªkª¾¹D¦³¨º¨ÇÀɦW¡A¦p¾÷1¡A¾÷2¡B¾÷3...µ¥µ¥

samwang

¦^´_ 41# wang077

ÁÙ¬O¦³°ÝÃD¡A¦]¬°µLªk±oª¾¾÷1¾÷2ªº¸ô®|¡A©Ò¥HµLªk¶}±ÒÀɮסA°£«D¬O©T©w¸ô®|©Î»Pµ{¦¡Àɮשñ¦P¤@­Ó¸ô®|¡A
¥t¥~±z10¼Ó»¡¦³¦n¦h­Ó¾÷¥x¡A¨º¬°¤°»ò²{¦b¥u¦³¹w³]¾÷1¾÷2?¬O¥t¥~»Ý¨D¶Ü?

samwang

¦^´_ 43# wang077

´£¨Ñ2ºØ¤èªk¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub UserForm_Activate()
Dim fs, f, fc, xD, a
Set fs = CreateObject("Scripting.FileSystemObject")
Set xD = CreateObject("Scripting.Dictionary")
'a = ThisWorkbook.Path  'µ{¦¡ÀÉ»P¸ê®ÆÀÉ©ñ¦P¤@­Ó¸ê®Æ§¨
a = "D:\test"                       '¸ê®ÆÀÉ©ñ¦b©T©w¸ô®|
fnorg = ActiveWorkbook.Name
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    n = n + 1
    If InStr(f1.Path, fnorg) Then GoTo 99
    Arr(n, 1) = f1.Path
    Arr(n, 2) = Split(f1.Name, ".")(0)
    xD(Arr(n, 2) & "") = ""
99: Next
Me.ListBox1.List = xD.keys
Set fs = Nothing: Set f = Nothing: Set fc = Nothing: Set xD = Nothing
EndSub:
End Sub

samwang

¦^´_ 48# wang077


§Ú´ú¸Õ¨S°ÝÃD¡A¥iªþ¥óÅý§Ú´ú¸Õ¬Ý¬Ý¶Ü? ÁÂÁÂ