ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

VBA §ì¨úListBox¤¤ªº¤º®e

¦^´_ 20# wang077


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

test2.zip (139.96 KB)

TOP

¦^´_ 21# samwang
¤j¤j¡A§ÚªºÅv­­¤£°÷¡A¨S¿ìªk载¤U¨Ó¡A¥i¥H¶Ç¨ì§Úªºmail¶Ü?
mail:[email protected]

TOP

¦^´_ 22# wang077


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

TOP

¦^´_ 23# samwang
¦¬¨ì¤F¡A·PÁÂÀ°¦£¡C

TOP

¦^´_ 9# samwang
¤j¤j¤£¦n·N«ä¡A¤p§Ì¦³¥t¤@­Ó°ÝÃD
·J¾ã.zip (231.23 KB)
¦p¦ó§â¾÷1»P¾÷2¨â­Óexcelªºsheet1¸ê®Æ¥ÎVBA·J¾ã¨ì·sªºexcel¸Ìªºsheet1
¤wªþ¤W½d¨Ò

TOP

¦^´_ 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

TOP

¦^´_ 26# samwang
´ú¸Õ¹L¤F¡A¨S°ÝÃD¡A«D±`·PÁ¤j¤j
¤j¤j¥i¥Hµy·L¸ÑÄÀ¤@¤U³o¨Çµ{¦¡½X¶Ü
¤p§Ì¯à¤O¸û®t¡A»Ý­n²z¸Ñ

TOP

¦^´_ 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

TOP

¦^´_ 26# samwang
·J¾ã.zip (804.22 KB)
¤j¤j¡A§A¥i¥HÀ°§Ú¬Ý¤@¤U¶Ü
·J¾ã¹L¥hªº¸ê®Æ¦³¨Ç®æ¦¡·|¶]±¼
µM«á¡A¦³¿ìªk³s¨ç¼Æ¤@°_·|¾ã¹L¥h¶Ü

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-7-5 10:23 ½s¿è

¦^´_ 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

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD