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

[µo°Ý] ±N¶}±Ò«áÀɮתº«ü©w¤º®e¨Ì§Ç½Æ»s¶K¤W¡C

[µo°Ý] ±N¶}±Ò«áÀɮתº«ü©w¤º®e¨Ì§Ç½Æ»s¶K¤W¡C

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-21 15:04 ½s¿è

TEST.rar (39.3 KB)
³Æµù¡G
7C¾÷¸ê®Æ§¨¤º¦@¦³1~98­ÓÀÉ®×(¥»ÃD¥H5­ÓÀɮ׬°¨Ò)¡C

»Ý¨D¡G
½Ð±N7C¾÷¸ê®Æ§¨¤ºªº¦Û°Ê¶}±ÒÀɮסA¥H¦WºÙªº²Ä4¬q¼Æ¦r¬°°ò·Ç(EX¡G7C¾÷_1878´Á_100_1877-10_1¦¸)~
¥Ñ¤j¦Ó¤p~±N¦U¤w¶}±ÒªºÀɮפº¤§"¾÷²vªí!"A&B¤GÄ檺¤º®e½Æ»s«á¡A¨Ì§Ç¶K¤W¥DÀɤ§"Sheet1!"ªºM1¡C

½Ð¸Ô¨£7C_0_1878´Á_5­Ó(®ÄªGÀÉ)¡C

¥H¤Wªº»Ý¨D»yªk
Àµ½Ð¦U¦ì¤j¤jÀ°¦£©M«ü±Ð ! ÁÂÁ !

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-23 08:18 ½s¿è

§Úªº§xÃøÂI¬O¦bµLªk¨Ì²Ä4¬q¼Æ¦r¿ï¾Ü"¥Ñ¤j¦Ó¤p"ªº¶¶§Ç~
¦]¬°µL½×±N"7C¾÷"¸ê®Æ§¨¤ºªºÀɮצWºÙ»¼¼W©Î»¼´î±Æ§Ç¡A
Àɮ׶}±Òªº¶¶§Ç³£¬O"¥Ñ¤p¦Ó¤j"¡A
©Ò¥H¤£ª¾¹D¦p¦ó°_©l½s¼gµ{¦¡½X ?

Àµ½Ð¦U¦ì¤j¤jÀ°¦£©M«ü±Ð ! ÁÂÁ !

TOP

¦^´_ 2# ziv976688


§Úªº§xÃøÂI¬O¦bµLªk¨Ì²Ä4¬q¼Æ¦r¿ï¾Ü"¥Ñ¤j¦Ó¤p"ªº¶¶§Ç~
>> ¥Ñ¤j¦Ü¤p¶}±ÒÀɮסA­×§ï¦p¤U¬õ¦r³¡¤À¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ


Private Sub CommandButton1_Click()
Dim Path As String, a, Ar(1 To 1000, 1 To 2)
    Nrange = "1878" ' InputBox("½Ð¿é¤JDATA!ªº¶}¼ú´Á¼Æ", "¿é¤J´Á¼Æ")
    Tm = Timer
    [L1] = ""
    Application.DisplayAlerts = False
   
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Path = ThisWorkbook.Path
    a = Path & "\7C¾÷"
    Set f = fs.GetFolder(a)
    Set fc = f.Files
    For Each f1 In fc
        n = n + 1
        Ar(n, 1) = a & "\" & f1.Name
        Ar(n, 2) = Split(Split(f1.Name, "_")(3), "-")(0)
    Next
    For i = 1 To UBound(Ar)
    For j = i + 1 To UBound(Ar)
        If Ar(i, 2) < Ar(j, 2) Then
            a = Ar(i, 1)
            Ar(i, 1) = Ar(j, 1)
            Ar(j, 1) = a
        End If
    Next j
    Next i
    For i = 1 To n
        Set WB = Workbooks.Open(Ar(i, 1))
        WB.Close
    Next
      
      
    With Sheets("Sheet1")
        .[A1] = Nrange
        .[A2].Formula = "=CountA(M1:GZ1) / 2 & ""­Ó""": .[A2] = .[A2].Value
        .[A3] = "¶}¼ú¸¹½X"
...
...

TOP

¦^´_ 3# samwang
·PÁ±zªº«ü¾É

¥Ñ¤j¦Ó¤p¶}±ÒÀɮתº»Ý¨D~OK¤F~·P®¦

¤£¦n·N«ä¡A¥i§_³Ò¾r±z±N¦U¤w¶}±ÒªºÀɮפº¤§"¾÷²vªí!"A&B¤GÄ檺¤º®e½Æ»s«á¡A
¨Ì§Ç¥Ñ¥DÀɤ§"Sheet1!"ªºM1©¹¥k¶K¤Wªºµ{¦¡»yªk¤@¨Ö½ç±Ð¡C
ÁÂÁ±z

TOP

¦^´_ 4# ziv976688

¥i§_³Ò¾r±z±N¦U¤w¶}±ÒªºÀɮפº¤§"¾÷²vªí!"A&B¤GÄ檺¤º®e½Æ»s«á¡A
¨Ì§Ç¥Ñ¥DÀɤ§"Sheet1!"ªºM1©¹¥k¶K¤Wªºµ{¦¡»yªk¤@¨Ö½ç±Ð¡C
>> µ{¦¡¦p¤U¬õ¦r¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

For i = 1 To UBound(Ar)    '¥Ñ¤j¦Ü¤p±Æ§Ç
    For j = i + 1 To UBound(Ar)
        If Ar(i, 2) < Ar(j, 2) Then
            a = Ar(i, 1)
            Ar(i, 1) = Ar(j, 1)
            Ar(j, 1) = a
        End If
    Next j
    Next i
   
    fileOrg = ActiveWorkbook.Name
    C = 13
    For i = 1 To n
        Set WB = Workbooks.Open(Ar(i, 1))
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            .Range("a1:b" & .[a65536].End(3).Row).Copy Workbooks(fileOrg).Sheets("Sheet1").Cells(1, C)
             C = C + 2
        End With
        WB.Close
    Next
   

    With Sheets("Sheet1")
        .[A1] = Nrange
        .[A2].Formula = "=CountA(M1:GZ1) / 2 & ""­Ó""": .[A2] = .[A2].Value
        .[A3] = "¶}¼ú¸¹½X"
        .[A4:A10].Formula = "=IF(A$1="""","""",VLOOKUP(A$1,DATA!$A:$H,ROW()-2,

TOP

¦^´_ 5# samwang
OK¤F
ÁÂÁ±z¤@¦Aªº«ü¾É©MÀ°¦£~·P®¦

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-23 21:39 ½s¿è

¦^´_ 5# samwang
TEST_0823.rar (225.26 KB)
Samwang¤j¤j¡G±z¦n!
·Q¥H 5#ªº¶Q¸Ñµ{¦¡½X¦A¶i¶¥¡G
½Ð±N­ì¶Q¸Ñ¡G¥H¦UÀɮצWºÙªº²Ä4¬q¼Æ¦r¬°°ò·Ç(EX¡G7C¾÷_1878´Á_100_1877-10_1¦¸)~¥Ñ¤j¦Ó¤p¶}±Òªºµ{¦¡½X~
¶i¶¥¬°¡G¥H¦U¸ê®Æ§¨¦WºÙªº²Ä5¬q¼Æ¦r¬°°ò·Ç(EX¡G7C _0_1878´Á_100_1877-10_1¦¸)~¥Ñ¤j¦Ó¤p¶}±Òªºµ{¦¡½X¡F
µM«á±N¦U¶}±Ò«áªº¸ê®Æ§¨¤¤¦³ÃöÁä¦r"¾÷"ªºÀÉ®×(EX¡G7C¾÷_1878´Á_100_1877-10_1¦¸)¶}±Ò~
¦A±N¸Ó¶}±Ò«áªºÀɮפº¤§"¾÷²vªí"ªºA&B¤GÄ椺®e½Æ»s«á¡A
¨Ì§Ç¥Ñ¥DÀɤ§"Sheet1!"ªºM1©¹¥k¶K¤W¡C
½Ð¸Ô¨£7C_0_1878´Á_5­Ó(®ÄªGÀÉ)
PS¡G®ÄªGÀɪº¤º®e»P5¼Óªº®ÄªGÀɬۦP¡C


¥H¤W Àµ½Ð½ç±Ð ! ÁÂÁ±z !

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-8-24 08:09 ½s¿è

¦^´_ 7# ziv976688


¥H¦U¸ê®Æ§¨¦WºÙªº²Ä5¬q¼Æ¦r¬°°ò·Ç(EX¡G7C _0_1878´Á_100_1877-10_1¦¸)~¥Ñ¤j¦Ó¤p¶}±Òªºµ{¦¡½X¡F
µM«á±N¦U¶}±Ò«áªº¸ê®Æ§¨¤¤¦³ÃöÁä¦r"¾÷"ªºÀÉ®×(EX¡G7C¾÷_1878´Á_100_1877-10_1¦¸)¶}±Ò~
¦A±N¸Ó¶}±Ò«áªºÀɮפº¤§"¾÷²vªí"ªºA&B¤GÄ椺®e½Æ»s«á¡A
¨Ì§Ç¥Ñ¥DÀɤ§"Sheet1!"ªºM1©¹¥k¶K¤W¡C
>> µ{¦¡¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton1_Click()
Dim Path$, a, Ar(1 To 1000, 1 To 2), Ar1()
Nrange = "1878" ' InputBox("½Ð¿é¤JDATA!ªº¶}¼ú´Á¼Æ", "¿é¤J´Á¼Æ")
Tm = Timer
[L1] = ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set fs = CreateObject("Scripting.FileSystemObject")
a = ThisWorkbook.Path     '¨C­Ó¸ê®Æ§¨¦WºÙ¸Ë¤JAr
Set f = fs.GetFolder(a)
Set fc = f.SubFolders
For Each f1 In fc
    n = n + 1
    Ar(n, 1) = f1.Path
    Ar(n, 2) = Split(Split(f1.Name, "_")(4), "-")(0)
Next
For i = 1 To UBound(Ar)   'Ar¥Ñ¤j¦Ü¤p±Æ§Ç
For j = i + 1 To UBound(Ar)
    If Ar(i, 2) < Ar(j, 2) Then
        a = Ar(i, 1)
        Ar(i, 1) = Ar(j, 1)
        Ar(j, 1) = a
    End If
Next j
Next i

For i = 1 To n            '¶}±ÒAr¡A§äÀɦW¦³"¾÷"¸Ë¤JAr1
    Set f = fs.GetFolder(Ar(i, 1))
    Set fc = f.Files
    For Each f1 In fc
        If InStr(f1.Path, "¾÷") Then
            ReDim Preserve Ar1(n1)
            Ar1(n1) = f1.Path
            n1 = n1 + 1
        End If
    Next f1
Next i

fileOrg = ActiveWorkbook.Name
C = 13
If n1 > 0 Then
    For i1 = 0 To n - 1   '¶}±ÒAr1¡Acopy A¡BBÄæ¸ê®Æ¨ìSheet1 MÄæ¶}©l©¹¥k
        Set WB = Workbooks.Open(Ar1(i1))
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            .Range("a1:b" & .[a65536].End(3).Row).Copy Workbooks(fileOrg).Sheets("Sheet1").Cells(1, C)
             C = C + 2
        End With
        WB.Close
    Next
End If
Set fs = Nothing: Set f = Nothing: Set fc = Nothing


  
With Sheets("Sheet1")
    .[A1] = Nrange
...
...

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-8-24 09:15 ½s¿è

¦^´_ 8# samwang
samwang¤j¤j : ±z¦n !
·PÁ½ç±Ð

´ú¸Õ«á¡A¦b¦C33   ReDim Preserve Ar1(n1)  ½s¿è¿ù»~(Åܼƥ¼©w¸q)
½Ð°Ý : ³o­ÓÅܼƭn«ç»ò¤U©w¸q?

Private Sub CommandButton1_Click()
Dim Path As String, a, Ar(1 To 1000, 1 To 2), Ar1( )
³o¼Ë¹ï¶Ü?
ÁÂÁ±z

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-8-24 09:34 ½s¿è

¦^´_ 9# ziv976688

¹ï­n©w¸q¡A8#¦³¤Ï¬õ¦â¦³©w¸q¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Dim Path As String, a, Ar(1 To 1000, 1 To 2), Ar1( )  

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD