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

¦h­Ó¤£¦PÀɮפu§@ªí½Æ»s¶°¤¤¶K¨ì1­ÓÀɮ׸̪º¤u§@ªí

¦h­Ó¤£¦PÀɮפu§@ªí½Æ»s¶°¤¤¶K¨ì1­ÓÀɮ׸̪º¤u§@ªí

¦U¦ì¥ý¶i¦n
¦]¬°¨Ï¥Î¦b2016©Î2018ª©¥»ªºEXCEL
¯S§O®e©ö·í¾÷©ÎÀÉ®×·l·´
©Ò¥H§Æ±æ¥ÎVBA°£¤F¤è«K¥~¤]§Æ±æ¤£·|±`±`³y¦¨ÀÉ®×·í¾÷©ÎÀÉ®×·l·´
¦pªþ¥ó
¦b¦P1­ÓÀɮק¨¸Ì
¦bÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤(¥Ø¿ý)"
¨Ì§Ç¿é¤J«ü©w"ÀɦW"©M«ü©w"¤u§@ªí¦WºÙ"§Æ±æ±N¸Ó¤u§@ªíªº"A~M"½Æ»s¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"A~M"Äæ¦ì
¨Ò¦p
(1)¶¶§Ç1«ü©w"0(1)"ªº"1216"¤u§@ªíªº"A~M"Äæ¦ì¸Ìªº¸ê®Æ½Æ»s¶K¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"A~M"Äæ¦ì
(2)¶¶§Ç2«ü©w"0(2)"ªº"1216"¤u§@ªíªº"A~M"Äæ¦ì¸Ìªº¸ê®Æ½Æ»s¶K¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"N~Z"Äæ¦ì
(3)¶¶§Ç3«ü©w"0(3)"ªº"1216"¤u§@ªíªº"A~M"Äæ¦ì¸Ìªº¸ê®Æ½Æ»s¶K¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"AA~AM"Äæ¦ì
(4)¶¶§Ç4«ü©w"0(4)"ªº"1216"¤u§@ªíªº"A~M"Äæ¦ì¸Ìªº¸ê®Æ½Æ»s¶K¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"AN~AZ"Äæ¦ì
(5)¶¶§Ç5«ü©w"0(4)"ªº"1216"¤u§@ªíªº"A~M"Äæ¦ì¸Ìªº¸ê®Æ½Æ»s¶K¨ìÀɦW¬°"¶°¤¤"ªº¤u§@ªí"¶°¤¤"ªº"BA~BM"Äæ¦ì
Image 35-1015-01.jpg
Image 35-1015-02.jpg

(20211015)Àɮ׶°¤¤.rar (500.46 KB)

¥»©«³Ì«á¥Ñ samwang ©ó 2021-10-18 10:34 ½s¿è

¦^´_ 1# oak0723-1

¦³3­Ó°ÝÃD¡A½Ð½T»{¹ê»Ú»Ý¨D¬°¦ó©ÎªÌ¥i°Ñ¦Ò«á¾Ç«Øij¡AÁÂÁÂ
1. Excel BÄ檺ÀɦW©M¹ê»ÚÀɦW¤£¤@¼Ë(¦³ªÅ¥Õ)®É­n¦p¦ó³B¸m?
2. Excel CÄ檺¤u§@ªí¦WºÙ¦³¼g¿ù®É­n¦p¦ó³B¸m?
3. Excel D¡BEÄæ°_©l/²×¤î¡A­n¥H¿é¤J¬°¥D¶Ü?

«Øij:
1. µ{¦¡ª½±µ¶}±Ò§ì¨ú¨º­Ó¸ê®Æ§¨ªºÀÉ®×
2. ±N©Ò¦³ÀɦW¶K¦Üsheet(¶°¤¤ (¥Ø¿ý)) ªºBÄæ
3. ±NÀɮתºsheet 1¸ê®Æ¶K¦Üsheet(¶°¤¤)¡A±qAÄæ¶}©l¶K¤J¸ê®Æ¨Ì§Ç©¹¥k¶K¨ìÀÉ®×µ²§ô
1.PNG

TOP

¦^´_ 1# oak0723-1

B¡BCÄæ¦p¿é¤J¿ù»~«hFÄæ·|Åã¥Ü¿ù»~(±Æ°£BÄæªÅ®æ°ÝÃD)¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Ar(), xD, a, n%, T, sh$, wb As Workbook, ws As Worksheet
Tm = Timer
Application.ScreenUpdating = False
a = ThisWorkbook.Path
Arr = Sheets(1).Range([b1], [c65536].End(3))
fileOrg = ActiveWorkbook.Name
Set xD = CreateObject("Scripting.Dictionary")
Set fs = CreateObject("Scripting.FileSystemObject")
a = ThisWorkbook.Path
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    T = Replace(Split(f1.Name, ".")(0), " ", "")
    xD(T) = f1.Path
Next
C = 1
For i = 3 To UBound(Arr)
    T = Replace(Arr(i, 1), " ", "")
    If xD.Exists(T) Then
        Set wb = Workbooks.Open(xD(T))
        sh = Arr(i, 2)
        On Error Resume Next
        Set ws = Worksheets(sh)
        If Err <> 0 Then
            wb.Close
            Sheets(1).Cells(i, 6) = "¤u§@ªí¦WºÙ¦³¿ù»~"
            Err.Clear: GoTo 99
        End If
        With Sheets(sh)
            If .FilterMode Then .ShowAllData
            Drr = .Range(.[m1], .[a65536].End(3))
            s = s + 1
        End With
        wb.Close
        Sheets("¶°¤¤").Cells(1, C).Resize(UBound(Drr), 13) = Drr
        C = C + 13
    Else
        Sheets(1).Cells(i, 6) = "ÀɦW¦³¿ù»~"
    End If
99: Next
Application.ScreenUpdating = True
Set wb = Nothing: Set ws = Nothing
MsgBox Timer - Tm
End Sub

TOP

¦^´_ 3# samwang


    ÁÂÁ§A
§Ú¦A´ú¸ÕÀ˵ø¤@¤U

TOP

¦^´_ 3# samwang


    §A¦n
¤£¦n·N«ä§Úº|¤F
¥i§_
À°§Ú¥[¤@­Ó±Æ§Ç¥\¯à
¤]´N¬O¨Ì¨C­ÓÀɮ׸ê®Æªº²Ä¤@Ä欰·Ç¥Ñ¤W¦Ü¤U¥Ñ¤p¦Ü¤j
­Y¸ê®Æ¤W¨ì¤U¤w¬O±q¤p±Æ¨ì¤j«h¤£»Ý¦A±Æ
Image 1101019-1.jpg
1101019_2.jpg

TOP

¦^´_ 5# oak0723-1

À°§Ú¥[¤@­Ó±Æ§Ç¥\¯à¡A¤]´N¬O¨Ì¨C­ÓÀɮ׸ê®Æªº²Ä¤@Ä欰·Ç¥Ñ¤W¦Ü¤U¥Ñ¤p¦Ü¤j
>> ­×§ï¦p¤U¬õ¦r³¡¤À¡AÁÂÁÂ

Sub test()
Dim Arr, Brr, Drr, Ar(), xD, a, n%, T, sh$, wb As Workbook, ws As Worksheet
Tm = Timer
Application.ScreenUpdating = False: Application.DisplayAlerts = False
...
...
...
With Sheets(sh)
            If .FilterMode Then .ShowAllData
            R = .[a65536].End(3).row
            With Range("a7:m" & R)
                Brr = .Value
                .Sort key1:=.Item(1), Order1:=1, Header:=2
            End With
            Drr = .Range("a1:m" & R)
            .Range("a7:m" & R) = Brr
        End With
        wb.Close
        Sheets("¶°¤¤").Cells(1, C).Resize(UBound(Drr), 13) = Drr
        C = C + 13
...
...
..
Application.ScreenUpdating = True: Application.DisplayAlerts = True
Set wb = Nothing: Set ws = Nothing
MsgBox Timer - Tm
End Sub
   

TOP

¦^´_ 6# samwang


    §A¦n
´ú¸Õµ²ªG
¨S¦³§ïÅÜ
¨Ã¨S¦³¥H²Ä¤@Äæ¦ì¬°·Ç¥Ñ¤W¦Ü¤U¥Ñ¤p¦Ü¤j±Æ§Ç³á
ÁÂÁÂ~
1020-1.jpg

(20211020)Àɮ׶°¤¤test01.rar (756.23 KB)

TOP

¦^´_ 7# oak0723-1

¨Ã¨S¦³¥H²Ä¤@Äæ¦ì¬°·Ç¥Ñ¤W¦Ü¤U¥Ñ¤p¦Ü¤j±Æ§Ç³á
>> ¦³¤p¤p±Æ¨ì¤j¦pªþ¥ó¡A§Ú²q¥i¯à¼Æ­È¬Ý¤£¥X¨Ó¡A¤w¸gÂର®É¶¡®æ¦¡¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
22.PNG

TOP

¦^´_ 7# oak0723-1

¹ï¤£°_¡A§Ñ¤FªþÀÉ¡A¤w¸É¤W¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

¶°¤¤_1020.zip (312.31 KB)

TOP

¦^´_ 9# samwang


   ÁÂÁ§A
§¹¦¨¤F
·P®¦~~~

TOP

        ÀR«ä¦Û¦b : ¦³Ä@©ñ¦b¤ß¸Ì¡A¨S¦³¨­Åé¤O¦æ¡A¥¿¦p¯Ñ¥Ð¤£¼½ºØ¡A¬Ò¬OªÅ¹L¦]½t¡C
ªð¦^¦Cªí ¤W¤@¥DÃD