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

[µo°Ý] ·j´M«e3¤j&«e3¤p­È¡C

[µo°Ý] ·j´M«e3¤j&«e3¤p­È¡C

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-9-5 18:27 ½s¿è

TEST_0905.rar (727.07 KB)
³Æµù¡G
«e3¤j©M«e3¤pªº¦W¦¸¥H¤¤¦¡±Æ¦W(§Y¦P¦W¦¸¥i¥H¦h­Ó)¬°°ò·Ç¡C
¥»½d¨Ò¦@¦³5­Ó¤l¸ê®Æ§¨(1883~1879)¡C
½s¼g¬yµ{½Ð¸ÑÃDªÌ¾Ü©y­q©w¡C

±NTEST¸ê®Æ§¨¤ºªº¦Un­Ó¤l¸ê®Æ§¨¨Ì¥Ñ¤j¦Ó¤p¶¶§Ç¥´¶}«á¡A
¦A¼W»Ý¨D¦p¤U¡G
1_±N¦³"²Î"ÃöÁä¦rªºÀɮצWºÙ¤§²Ä4¬q"¼Æ¦r¥Ñ¤j¦Ó¤p"¡A±qSheets("Sheet1").[A33]°_©l¡A¨C¸õ17¦C¨Ì§Ç©¹¤U¶ñ¤J¡C

2_¥H¤W­z¥´¶}«áªºÀɮסG
·j´MDÄæ©MEÄ椧³æÄ檺«e3¤jªº¼Æ­È©M«e3¤pªº¼Æ­È¡A¨Ã¥H¦P¦CªºBÄæ­È¡A¹ïÀ³Sheets("Sheet1").[C1:AY1]ªº¦P­È¡A
µM«á¦bSheets("Sheet1")AÄæ¬Û¦P´Á¼Æ¥kÃäÁ`¦¸¼Æ©M­¿¼Æ¤§«e3¤j©M«e3¤pªº¹ïÀ³Àx¦s®æ¶ñ¤W"V"~
EX¡G¶}±Ò7²Î_0_1884´Á_1883_49­Ó_1¦¸ªºÀÉ®×~
DÄæ³Ì¤j­È=D31=396¡F¦P¦CB31=30¡F«h¦bSheets("Sheet1").[AF34]¶ñ¤J"V"
DÄ榸¤j­È=D42=378¡F¦P¦CB42=41¡F«h¦bSheets("Sheet1").[AQ35]¶ñ¤J"V"
DÄæ¤T¤j­È=D34=372¡F¦P¦CB34=33¡F«h¦bSheets("Sheet1").[AI36]¶ñ¤J"V"
DÄæ³Ì¤p­È=D22=156¡F¦P¦CB22=21¡F«h¦bSheets("Sheet1").[W38]¶ñ¤J"V"
DÄ榸¤p­È=D41=192¡F¦P¦CB41=40¡F«h¦bSheets("Sheet1").[AP39]¶ñ¤J"V"
DÄæ¤T¤p­È=D43=198¡F¦P¦CB43=42¡F«h¦bSheets("Sheet1").[AR40]¶ñ¤J"V"

·j´MEÄ檺¤§«e3¤jªº¼Æ­È©M«e3¤pªº¼Æ­È¡A¨Ã¥H¦P¦CªºBÄæ­È¡A¹ïÀ³Sheets("Sheet1").[C1:AY1]ªº¦P­È¡A
µM«á¦bSheets("Sheet1")AÄæ¬Û¦P´Á¼Æ¥kÃä­¿¼Æªº«e3¤j©M«e3¤p¤§¹ïÀ³Àx¦s®æ¶ñ¤W"V"~
EÄæ³Ì¤j­È=E31=8.082¡F¦P¦CB31=30¡F«h¦bSheets("Sheet1").[AF42]¶ñ¤J"V"
EÄ榸¤j­È=E42=7.714¡F¦P¦CB42=41¡F«h¦bSheets("Sheet1").[AQ43]¶ñ¤J"V"
EÄæ¤T¤j­È=E34=7.592¡F¦P¦CB34=33¡F«h¦bSheets("Sheet1").[AI44]¶ñ¤J"V"
EÄæ³Ì¤p­È=E22=3.250¡F¦P¦CB22=21¡F«h¦bSheets("Sheet1").[W46]¶ñ¤J"V"
EÄ榸¤p­È=E43=4.041¡F¦P¦CB43=42¡F«h¦bSheets("Sheet1").[AR47]¶ñ¤J"V"
EÄæ¤T¤p­È=E41=4.085¡F¦P¦CB41=40¡F«h¦bSheets("Sheet1").[AP48]¶ñ¤J"V"

¨ä¾l1882~1879Ãþ±À¡G¸Ô¦p½d¨Ò¡C

¥H¤W»Ý¨D»yªk~Àµ½Ð¦U¦ì¤j¤j«ü¾É©MÀ°¦£¡I ÁÂÁ¡I

¦^´_ 1# ziv976688


·j´MDÄæ©MEÄ椧³æÄ檺«e3¤jªº¼Æ­È©M«e3¤pªº¼Æ­È¡A¨Ã¥H¦P¦CªºBÄæ­È¡A¹ïÀ³Sheets("Sheet1").[C1:AY1]ªº¦P­È¡A
>> ·s¼W¬õ¦r¦p¤U¡A½Ð¸Õ¬Ý¬Ý¡AÁÂÁ   

Private Sub CommandButton1_Click()
Dim Path As String, A, Ar(1 To 1000, 1 To 2), Ar1(), Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
Dim Ar2(), Drr(1 To 16, 1 To 49), R%, K%
...
...
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
If n1 > 0 Then
    R = 33
    ªíÀY = Array("Á`¦¸¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p", _
                  "­¿¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p")
    For i1 = 0 To n - 1   '¶}±ÒAr1
        Set WB = Workbooks.Open(Ar1(i1))
        fn = Split(Ar1(i1), "_")(5)
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            With .Range(.[B1], .[E65536].End(3))
                Crr = .Value
                .Sort Key1:=.Item(3), Order1:=2, Header:=1
                Arr = .Value
                .Value = Crr
            End With
        End With
        WB.Close
        For i = 2 To 4  '«e3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr(i, 1): K = K + 1
        Next
        For i = UBound(Arr) To 48 Step -1 '³Ì«á3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr(i, 1): K = K + 1
        Next
        For i = 0 To UBound(Ar2)
            T = Ar2(i)
            If i < 3 Then
                Drr(i + 1, T) = "V": Drr(i + 9, T) = "V"
            Else
                Drr(i + 2, T) = "V": Drr(i + 10, T) = "V"
            End If
        Next
        With Sheets("Sheet1")
            .Range("a" & R) = fn
            .Range("b" & R).Resize(16) = Application.Transpose(ªíÀY)
            .Range("c" & R + 1).Resize(15, 49) = Drr
            R = .[b65536].End(3).Row + 1
        End With
        Erase Ar2: Erase Drr: K = 0
    Next
End If
Set fs = Nothing: Set f = Nothing: Set fc = Nothing
...
...

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-9-6 14:27 ½s¿è

¦^´_ 2# samwang
ÁÂÁ±zªº¦A¦¸«ü¾É¡C
´ú¸Õµ²ªG :
¢°¡Ä¤Ö¤F1¦C¶¡¹jªÅ¥Õ¦C~
EX¡F
¢Ï¢³¢¸¡×¢°¢·¢·¢±¡A¢Ð¢³¢¸¡G¢Ð¢µ¢³¡×ªíÀY
¥¿½T¬°¡G
¢Ï¢´¢¯¡×¢°¢·¢·¢±¡A¢Ð¢´¢¯¡G¢Ð¢µ¢´¡×ªíÀY

¢Ï¢µ¢´¡×¢°¢·¢·¢°¡A¢Ð¢µ¢´¡G¢Ð¢·¢¯¡×ªíÀY
¥¿½T¬°¡G
¢Ï¢µ¢¶¡×¢°¢·¢·¢°¡A¢Ð¢µ¢¶¡G¢Ð¢·¢±¡×ªíÀY

¢Ï¢·¢°¡×¢°¢·¢·¢¯¡A¢Ð¢·¢°¡G¢Ð¢¸¢µ¡×ªíÀY
¥¿½T¬°¡G
¢Ï¢·¢³¡×¢°¢·¢·¢¯¡A¢Ð¢·¢³¡G¢Ð¢¸¢¸¡×ªíÀY


¨ä¾l¡D¡D¡DÃþ±À

¢±¡Ä¢äªºÁ`¼Æ¶q¥Ø«e¬O¢´¢·­Ó¡]¥¿½T¬O¢µ¢¯­Ó¡^¡ã5´Á*2Äæ*(«e3¤j+«e3¤p)>=60~
¦ý³o­Óµ¥¤W¶µ¦C¼Æ½Õ¾ã«á¡A¤p§Ì¦A´ú¸Õµ²ªG¡ã¦p¯u¦³»~®É¡A¦A³Ò·Ð±z­×¥¿¡C
ÁÂÁ±z
7«e3¤j&¤p_0_1884´Á_5´Á_1¦¸.rar (15.68 KB)

TOP

¦^´_ 3# ziv976688


¢°¡Ä¤Ö¤F1¦C¶¡¹jªÅ¥Õ¦C~
>> §ó§ï¦p¤U¬õ¦r¡AÁÂÁÂ

With Sheets("Sheet1")
            .Range("a" & R) = fn
            .Range("b" & R).Resize(16) = Application.Transpose(ªíÀY)
            .Range("c" & R + 1).Resize(15, 49) = Drr
            R = .[b65536].End(3).Row + 2
End With

TOP

¦^´_ 4# samwang
ÁÂÁ±zªº½ç¥¿¡C
¥´"V"ªº³¡¤À~§Úªº®ÄªGÀɽd¨Ò¤]¦³µ§º|~½Ð¦bAP91¶ñ¤J"V"¡CÁÂÁÂ!

¥´"V"³¡¤Àªº´ú¸Õµ²ªG :
1882¡F1881¡F1879~OK

1883~½Ð­×¥¿¤U¦CÀx¦s®æ~
AP47=""¡FAR47=V
AP48=V¡FAR48=""
¸Ô¦p :7²Î_0_1884´Á_1883_¦W¦¸¤ñ¹ï¥Î

1880~½Ð­×¥¿¤U¦CÀx¦s®æ~
W91=V
AP48=V¡FAR48=""
W99=V¡FAP99=""
¸Ô¦p :7²Î_0_1884´Á_1880_¦W¦¸¤ñ¹ï¥Î

PS :
1_COUNTIF(C34:AY116,"V")=61­Ó
2_BUG³£¬Oµo¥Í¦bD©ME¤GÄ檺¦P¦W¦¸¤£¬O¦P¤@¦C©M¦P¦W¦¸¦³2­Ó(§t)¥H¤W®É~
½Ð°Ý : DÄæ©MEÄ檺¦W¦¸¬O§_¦³¤À§O²Î­p?

¥H¤W Àµ½Ð½ç¥¿¡C  ÁÂÁ±z^^
0906.rar (59.63 KB)

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-9-6 21:45 ½s¿è

¦^´_ 5# ziv976688


1883~½Ð­×¥¿¤U¦CÀx¦s®æ~
AP47=""¡FAR47=V
AP48=V¡FAR48=""
¸Ô¦p :7²Î_0_1884´Á_1883_¦W¦¸¤ñ¹ï¥Î  
>> ½Ð©¿²¤#2µ{¦¡½X¡A¤w­«·s§ó·s¦p¤U¬õ¦r¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton1_Click()
Dim Path As String, A, Ar(1 To 1000, 1 To 2), Ar1(), Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
Dim Ar2(), Drr(1 To 16, 1 To 49), Arr1,R%, K%, CR%, R1%
...
...
fileOrg = ActiveWorkbook.Name
If n1 > 0 Then
R = 33
    ªíÀY = Array("Á`¦¸¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p", _
                  "­¿¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p")
    For i1 = 0 To n - 1   '¶}±ÒAr1
        Set WB = Workbooks.Open(Ar1(i1))
        fn = Split(Ar1(i1), "_")(5)
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            With .Range(.[B1], .[E65536].End(3))
                Crr = .Value
                .Sort Key1:=.Item(3), Order1:=2, Header:=1
                Arr = .Value    'Á`¦¸¼Æ
                .Sort Key1:=.Item(4), Order1:=1, Header:=1
                Arr1 = .Value   '­¿¼Æ
                .Value = Crr
            End With
        End With
        WB.Close
        For i = 2 To 4                      'Á`¦¸¼Æ:³Ì¤j3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr(i, 1): K = K + 1
        Next
        For i = UBound(Arr) To 48 Step -1   'Á`¦¸¼Æ:³Ì¤p3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr(i, 1): K = K + 1
        Next
        For i = UBound(Arr1) To 48 Step -1  '­¿¼Æ:³Ì¤j3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr1(i, 1): K = K + 1
        Next
        For i = 2 To 4                      '­¿¼Æ:³Ì¤p3¼Æ­È
            ReDim Preserve Ar2(K): Ar2(K) = Arr1(i, 1): K = K + 1
        Next
        For i = 0 To UBound(Ar2)
            T = Ar2(i)
            If CR = 3 Then CR = 0: R1 = R1 + 2 Else R1 = R1 + 1
            Drr(R1, T) = "V": CR = CR + 1
        Next
        With Sheets("Sheet1")
            .Range("a" & R) = fn
            .Range("b" & R).Resize(16) = Application.Transpose(ªíÀY)
            .Range("c" & R + 1).Resize(15, 49) = Drr
            R = .[b65536].End(3).Row + 2
        End With
        Erase Ar2: Erase Drr: K = 0: CR = 0: R1 = 0
    Next
End If

Set fs = Nothing: Set f = Nothing: Set fc = Nothing
...
...

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-9-6 22:54 ½s¿è

¦^´_ 6# samwang
ÁÂÁ±zªº½ç¥¿   
´ú¸Õµ²ªG :
¤£¦n·N«ä¡A©|¦³¤@³B¦³¿òº|~
1880~
Á`¦¸¼Æªº¤T¤p¦³2­Ó~21©M40(¤¤¦¡±Æ¦W~"¦P¦W¦¸" >=1­Ó®É¡A³£­n°O¿ý)
W91  ¨S¦³°O¿ý¨ì
©Ò¥H~
W91=V
Àµ½Ð±z½ç¥¿¡C
ÁÂÁ±z
7«e3¤j&¤p_0_1884´Á_5´Á_1¦¸_W91.rar (13.12 KB)

TOP

¦^´_ 7# ziv976688


¤£¦n·N«ä¡A¨S¦³·Q¨ì³o»ò½ÆÂø¡A¨º´N¥u¯à¨C¦¸¤j¤p¤À¶}­pºâ¡A¦]¬°¨C²Õ¤j¤p¸Ì­±ªº¼Æ¾Ú³£¦³¥i¯à­«½Æ¥B¥i¯ànµ§­«½Æ¸ê®Æ¡A¹ï§a?   

¨Ò¦p: Á`¦¸¼Æ³Ì¤j¼Æ­È¡A¼Æ­È: 21(³Ì¤j)¡B40(2st)¡B41(2st)¡B42(3st) ©Î  21(³Ì¤j)¡B40(2st)¡B41(3st)¡B42(3st) ©Î ....

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-9-7 10:51 ½s¿è

¦^´_ 8# samwang
±z¤Ó«È®ð¤F!±z¤w¸gÀ°§Ú«Ü¦h¦£¤F~ÁÂÁ±z

¤£¬O»¡"±Ð¾Ç¬Ûªø"¶Ü?
§Ú­Ì³£­@¤ßµ¥µ¥~
¬ÝÁÙ¦³¨S¦³¨ä¥L°ª¤âÄ@·NÀ°¦£©M«ü¾É¡C

TOP

¦^´_ 7# ziv976688


Á`¦¸¼Æªº¤T¤p¦³2­Ó~21©M40(¤¤¦¡±Æ¦W~"¦P¦W¦¸" >=1­Ó®É¡A³£­n°O¿ý)
W91  ¨S¦³°O¿ý¨ì
>> ¦]¬°«e3¤j¤p¦³­«½Æ­È¡A©Ò¥H¤À¶}²Î­p¤ñ¹ï¸ê®Æ¡A§ó·s¦p¤U¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁ   

Private Sub CommandButton1_Click()
Dim Path As String, A, Ar(1 To 1000, 1 To 2), Ar1(), Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
Dim Drr(1 To 3, 1 To 49), Arr1, R%, K21%, K22%, K31%, K32%, R21%, R22%, R31%, R32%, T1%
Dim Ar21(1 To 10, 1 To 2), Ar22(1 To 10, 1 To 2), Ar31(1 To 10, 1 To 2), Ar32(1 To 10, 1 To 2)
Set xD = CreateObject("Scripting.Dictionary")

...
...
If n1 > 0 Then
R = 33
     ªíÀY = Array("Á`¦¸¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p", _
                   "­¿¼Æ", "³Ì¤j", "¦¸¤j", "¤T¤j", "", "³Ì¤p", "¦¸¤p", "¤T¤p")
     For i1 = 0 To n - 1   '¶}±ÒAr1
         Set WB = Workbooks.Open(Ar1(i1))
         fn = Split(Ar1(i1), "_")(5)
         With Sheets(1)
             If .FilterMode Then .ShowAllData
             With .Range(.[B1], .[E65536].End(3))
                 Crr = .Value
                 .Sort Key1:=.Item(3), Order1:=2, Header:=1
                 Arr = .Value    'Á`¦¸¼Æ
                .Sort Key1:=.Item(4), Order1:=2, Header:=1
                 Arr1 = .Value   '­¿¼Æ
                .Value = Crr
             End With
         End With
         WB.Close
         For i = 2 To UBound(Arr)           'Á`¦¸¼Æ:³Ì¤j3¼Æ­È
            K21 = K21 + 1: If K21 > 3 And xD(Arr(i, 3) & "_21") <> 1 Then Exit For
            Ar21(K21, 1) = Arr(i, 1): Ar21(K21, 2) = Arr(i, 3): xD(Arr(i, 3) & "_21") = 1
         Next
         For i = UBound(Arr) To 2 Step -1   'Á`¦¸¼Æ:³Ì¤p3¼Æ­È
            K22 = K22 + 1: If K22 > 3 And xD(Arr(i, 3) & "_22") <> 1 Then Exit For
            Ar22(K22, 1) = Arr(i, 1): Ar22(K22, 2) = Arr(i, 3): xD(Arr(i, 3) & "_22") = 1
         Next
         For i = 2 To UBound(Arr1)          '­¿¼Æ:³Ì¤j3¼Æ­È
            K31 = K31 + 1: If K31 > 3 And xD(Arr1(i, 4) & "_31") <> 1 Then Exit For
            Ar31(K31, 1) = Arr1(i, 1): Ar31(K31, 2) = Arr1(i, 4): xD(Arr1(i, 4) & "_31") = 1
         Next
        For i = UBound(Arr1) To 2 Step -1   '­¿¼Æ:³Ì¤p3¼Æ­È
            K32 = K32 + 1: If K32 > 3 And xD(Arr1(i, 4) & "_32") <> 1 Then Exit For
            Ar32(K32, 1) = Arr1(i, 1): Ar32(K32, 2) = Arr1(i, 4): xD(Arr1(i, 4) & "_32") = 1
         Next
         
         With Sheets("Sheet1")
            .Range("a" & R) = fn
            .Range("b" & R).Resize(16) = Application.Transpose(ªíÀY)
            For i = 1 To K21 - 1  'Á`¦¸¼Æ:³Ì¤j3¼Æ­È
                T = Ar21(i, 2): If T1 = T Then R21 = R21 Else R21 = R21 + 1
                Drr(R21, Ar21(i, 1)) = "V": T1 = T
            Next
            .Range("c" & R + 1).Resize(3, 49) = Drr
            R = .[b65536].End(3).Row - 10: Erase Drr: T1 = 0
            For i = 1 To K22 - 1  'Á`¦¸¼Æ:³Ì¤p3¼Æ­È
                T = Ar22(i, 2): If T1 = T Then R22 = R22 Else R22 = R22 + 1
                Drr(R22, Ar22(i, 1)) = "V": T1 = T
            Next
            .Range("c" & R).Resize(3, 49) = Drr
            R = .[b65536].End(3).Row - 6: Erase Drr: T1 = 0
            
            For i = 1 To K31 - 1  '­¿¼Æ:³Ì¤j3¼Æ­È
                T = Ar31(i, 2): If T1 = T Then R31 = R31 Else R31 = R31 + 1
                Drr(R31, Ar31(i, 1)) = "V": T1 = T: T1 = 0
            Next
            .Range("c" & R).Resize(3, 49) = Drr
            R = .[b65536].End(3).Row - 2: Erase Drr: T1 = 0
            For i = 1 To K32 - 1  '­¿¼Æ:³Ì¤p3¼Æ­È
                T = Ar32(i, 2): If T1 = T Then R32 = R32 Else R32 = R32 + 1
                Drr(R32, Ar32(i, 1)) = "V": T1 = T: T1 = 0
            Next
            .Range("c" & R).Resize(3, 49) = Drr
            R = .[b65536].End(3).Row + 2: Erase Drr: T1 = 0
         End With
         Erase Ar21: Erase Ar22: Erase Ar31: Erase Ar32: xD.RemoveAll
         K21 = 0: K22 = 0: K31 = 0: K32 = 0: R21 = 0: R22 = 0: R31 = 0: R32 = 0
     Next
End If
Set fs = Nothing: Set f = Nothing: Set fc = Nothing
...
...

TOP

        ÀR«ä¦Û¦b : ¦³´¼¼z¤~¯à¤À¿ëµ½´c¨¸¥¿¡F¦³Á¾µê¤~¯à«Ø¥ß¬üº¡¤H¥Í¡C
ªð¦^¦Cªí ¤W¤@¥DÃD