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

[µo°Ý] ¥Ñ¤p¦Ó¤j§ï¬°¥Ñ¤j¦Ó¤pªº»yªk¬ã²ß¡C

[µo°Ý] ¥Ñ¤p¦Ó¤j§ï¬°¥Ñ¤j¦Ó¤pªº»yªk¬ã²ß¡C

TEST_0914.rar (227.47 KB)
±N¤U¦Cªº·j´M¶}±Ò±Æ§Ç~¥H¥Ñ¤p¦Ó¤j(¶¶§Ç)§ï¬°¥Ñ¤j¦Ó¤p(­Ë§Ç)¡C
½Ð°Ý»yªk­n¦p¦ó½s¼g¡H
ÁÂÁ¡I


Private Sub CommandButton1_Click()
Dim Path$, xD1, A, Ar(1 To 5000, 1 To 2), Ar1(), Arr, Brr(1 To 7), Crr, xD, T%, i&, j&, k&
Application.DisplayAlerts = False: Application.ScreenUpdating = False
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
fileOrg = ActiveWorkbook.Name
Tm = Timer
Nrange = InputBox("½Ð¿é¤JDATA!ªº¶}¼ú´Á¼Æ", "¿é¤J´Á¼Æ")
num = "100" 'InputBox("½Ð¿é¤J®ÄªGÀÉA¡JH½Æ»sªº´Á¶Z¼Æ½d³ò", "¿é¤J¶Z´Á¼Æ")
Order = "0" ' InputBox("½Ð¿é¤J¼W¥[ªºÅÞ¿è±ø¥ó±ø¥ó¤§°_¨´§Ç¸¹", "¿é¤J§Ç¸¹(1~99)©Î¤£¼W¥[(«öEnter)")
Ncount = "1" ' InputBox("½Ð¿é¤JÅçÃÒª©ªº³sÄò¦¸¼Æ", "¿é¤J¦¸¼Æ(1~10)")
Sheets("DATA").[L1:L4] = ""

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): xD1(Ar(n, 2)) = 1
Next

For Each Ky In xD1
    For x = 1 To n          '¶}±ÒAr,§ä¦PÃþ«¬¸ê®Æ§¨¡AÀɦW¦³"¾÷"¸Ë¤JAr1
        If Ar(x, 2) = Ky Then
            Set f = fs.GetFolder(Ar(x, 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
        End If
    Next x
    C = 13
    If n1 > 0 Then
        For i1 = 0 To n1 - 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

'.................................................................................................................

¦^´_ 2# samwang
For i1 = n1 - 1 To 0 Step -1
­ì¨Ó­Ë§ÇÁÙ­n¦h Step -1¤~¥¿½T¡C
ÁÂÁ±zªº«ü¾É

TOP

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

¦^´_ 2# samwang
TEST_0916.rar (240.68 KB)
¤£¦n·N«ä¡AÁÙ¦³¤@­Ó"§ïÅÜÄæ¦ìªº²Î­pÅ޿褧»yªk¬ã²ß"~Àµ½Ð±z½ç±Ð :
½Ð±N¤U¦CE:KÄæ¦ìªº²Î­pÅÞ¿è§ï¬°~
EÄæ(­¿²v) =$A$2>0®É¡ADÄ檺­È/$A$2¡F¨Ã½Ð±NEÄæ­È¨ú¤p¼ÆÂI«á3¦ì¼Æ¡A²Ä4¦ì¥|±Ë¤­¤J(=ROUND(D2/$A$2,3))
JÄæ(Á`¦¸¼Æ) =±NDÄ檺­È¥Ñ¤j¦Ó¤p(­Ë§Ç)©¹¤U¶ñ¤J¡C
GÄæ(Á`­Ó¼Æ) =¥ý·j´MDÄæ»PJÄæ¬Û¦P­È¡A«á±N¸ÓDÄæ­È¦bCÄ檺¦P¦C­È©¹¤U¶ñ¤J¡C
HÄæ(±Æ¦W)=±NDÄæ­È¥H¤¤¦¡±Æ¦Wªº±Æ§Ç©¹¤U¶ñ¤J¡C
IÄæ(¼Æ¦r) =¥ý·j´MDÄæ»PJÄæ¬Û¦P­È¡A«á±N¸ÓDÄæ­È¦bBÄ檺¦P¦C­È©¹¤U¶ñ¤J¡C
KÄæ(­¿²v) =¥ý·j´MDÄæ»PJÄæ¬Û¦P­È¡A«á±N¸ÓDÄæ­È¦bEÄ檺¦P¦C­È©¹¤U¶ñ¤J¡C

½Ð°Ý»yªk­n¦p¦ó½s§ï¡H
ÁÂÁ±z¡I

        Arr = .Range(.[C1], .[B65536].End(3))
        For i = 2 To UBound(Arr)
            For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
            If xD(Arr(i, 1) & "/1") = "" Then Arr(i - 1, 1) = 0: Arr(i - 1, 2) = 0 '­n·s¼W
        Next
        .[C2].Resize(UBound(Arr) - 1, 2) = Arr  'C&DÄæ

        Arr = .Range(.[E2], .[B65536].End(3))
        ReDim Crr(1 To UBound(Arr), 1 To 5)
        For i = 1 To UBound(Arr)
            If Arr(i, 3) > 0 Then Arr(i, 4) = Arr(i, 3) / .[A2] 'EÄæ
            Crr(i, 1) = Arr(i, 2): Crr(i, 2) = Arr(i, 2)
            Crr(i, 3) = Arr(i, 1): Crr(i, 4) = Arr(i, 3)
            Crr(i, 5) = Arr(i, 4)
        Next
        .[B2].Resize(UBound(Arr), 4) = Arr
        With .Range("g2").Resize(UBound(Crr), 5) 'GÄæ
            .Value = Crr
            .Sort key1:=.Item(1), Order1:=2, Header:=xlNo
            Crr = .Value
        End With
        T = Application.Max(.Range("g2:g" & UBound(Crr)))
        For i = 1 To UBound(Crr)
            Crr(i, 1) = T - Crr(i, 1) + 1
        Next
        .[H2].Resize(UBound(Crr), 1) = Crr 'HÄæ

TOP

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

¦^´_ 5# samwang
±z¦n!
´ú¸ÕOK~§¹¥þ²Å¦X»Ý¨D
¸U¤À·PÁ±zªº«ü¾É©MÀ°¦£~·P®¦

TOP

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

¦^´_ 7# samwang
«D±`ÁÂÁ±zªº¸É¥R~·P®¦

¤£¦n·N«ä~¦pªG³Q·j´Mªº¸ê®Æ§¨¦WºÙ²Ä5¬q¦³2­Ó(§t)¥H¤Wªº¤£¦P¼Æ¦r®É¡A·|²£¥Í°»¿ù~¦p¹Ï¤ù~
¦ý¬O®ÄªGÀÉ«o¦³¥¿½T²£¥Í
Àµ½Ð½ç¥¿¡CÁÂÁ±z
7C_0_1895´Á.rar (218.83 KB)

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-9-17 01:29 ½s¿è

¦^´_ 7# samwang
¤£¦n·N«ä~¦ý¬O®ÄªGÀÉ«o¦³¥¿½T²£¥Í~»¡¿ù¤F~­×¥¿ :
7²Î_0_1895´Á_100_1893_2­Ó_1¦¸ªº®ÄªGÀɬO¥¿½Tªº~
¦ý¬O7²Î_0_1895´Á_100_1894_3­Ó_1¦¸ªº®ÄªGÀɤ§HÄæ±Æ¦W¤£¥¿½T(¥H¤W­z1893ÀɮתºHÄæ±Æ¦W¦A³sÄò[/b])

TOP

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

¦^´_ 10# samwang
¤£¦n·N«ä~7²Î_0_1895´Á_100_1894_3­Ó_1¦¸ªºHÄæ±Æ¦WÁÙ¬O©ÓÄò1893ªºHÄæ±Æ¦W¡C
1893HÄæ±Æ¦W=1~13¡F1894HÄæ±Æ¦W=14~24
Àµ½Ð½ç¥¿!ÁÂÁ±z   

TOP

¦^´_ 12# samwang
·PÁ±zªº­@¤ß«ü¾É~OK¤F~·P®¦

¤£¦n·N«ä~ÁÙ¦³¤@­Ó»Ý¨D~·q½Ð«ü±Ð!ÁÂÁ±z !
Åã¥Ü"V"¦r§ï¬°Åã¥Ü¼Æ­È¡C
TEST_0917.rar (277.26 KB)
¥Ø«e~H_·j´M(²Î)¦rÀÉ(¥DÀÉ)_0917_Q ~
¬O±N©Ò¦³¦³"²Î"ÃöÁä¦rªº¦WºÙÀÉ®×(¥»ÃD¦³2­Ó)¡A¥H¨ä²Ä5¬q¼Æ¦r¥Ñ¤j¦Ó¤p¨Ì§Ç¶}±Ò«á~
²Î­p¸ÓÀÉ®×D&E¤GÄ檺¦U«e3¤j©M«e3¤p(¤¤¦¡±Æ¦W)¤§­È¡A¨Ã¥H¨ä¦bBÄ檺¦P¦C­È~
¦bSheets("Sheet1")C$1 : AY$1ªº¬Û¦P­È¤§C34:AY¶ñ¤J"V"~

»Ý¨D¡G
±N¤W­zªº¦bSheets("Sheet1")C$1 : AY$1ªº¬Û¦P­È¤§C34:AY¶ñ¤J[b]"V"~
§ï¬°
¦bSheets("Sheet1")C$1 : AY$1ªº¬Û¦P­È¤§C34:AY¶ñ¤J«e3¤j©M«e3¤p(¤¤¦¡±Æ¦W)ªº¸Ó¼Æ­È¡C
¸Ô¦p½d¨ÒªþÀÉ

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

TOP

¦^´_ 14# samwang
samwang¤j¤j :
´ú¸Õµ²ªG : §¹¥þ²Å¦X»Ý¨D
¸U¤À·P¿E±zªÖ¸òÃD­@¤ß«ü¾É©M¼ö¤ßÀ°¦£~¨ü´f¨}¦h~·P®¦

TOP

¦^´_ 14# samwang
¤£¦n·N«ä¡A¦³­Ó¤p°ÝÃD¡A½Ð±z«ü±Ð~ÁÂÁ±z¡I

·í¸ê®Æ§¨¦WºÙ=7C_0_1894´Á_100_1845-1893_10+1796-1892_10_1¦¸_1-49¤ºªº¦UÀɮסG
¥HH_·j´M(¾÷)¦rÀÉ(¥DÀÉ)_0917_samwang°õ¦æ~²£¥Í¤U¦C¦@5­Óªº¦³(²Î)ÃöÁä¦rªºÀÉ®×~
7²Î_0_1894´Á_100_1889_2­Ó_1¦¸~7²Î_0_1894´Á_100_1893_2­Ó_1¦¸

¦A¥HH_·j´M(²Î)¦rÀÉ(¥DÀÉ_Åã¥Ü¼Æ­È)_0917_samwang°õ¦æ«á~
²£¥Í7«e3¤j&¤p_0_1894´Á_5­Ó_1¦¸ªº®ÄªGÀɬOOKªº¡C
EX¡Gªþ¥ó½d¨Ò~´ú¸Õ_1894(Âù¼h=0000+0000)
´ú¸Õ_1894(Âù¼h=0000+0000).rar (302.5 KB)

·í¸ê®Æ§¨¦WºÙ= 7C_0_1894´Á_100_1874-1893_10_1¦¸_1-49¤ºªº¦UÀɮסG
¥HH_·j´M(¾÷)¦rÀÉ(¥DÀÉ)_0917_samwang°õ¦æ~²£¥Í¤U¦C¦@5­Óªº¦³(²Î)ÃöÁä¦rªºÀÉ®×~
7²Î_0_1894´Á_100_1889_1­Ó_1¦¸~7²Î_0_1894´Á_100_1893_1­Ó_1¦¸

¦A¥HH_·j´M(²Î)¦rÀÉ(¥DÀÉ_Åã¥Ü¼Æ­È)_0917_samwang°õ¦æ«á~
¦bµ{¦¡½X¦C68·|²£¥Í°»¿ù~¸Ô¦p¹Ï¤ù¡C

EX¡Gªþ¥ó½d¨Ò~´ú¸Õ_1894(³æ¼h=0000)
´ú¸Õ_1894(³æ¼h=0000).rar (229.94 KB)

ºî¤W©Ò­z¡G
H_·j´M(²Î)¦rÀÉ(¥DÀÉ_Åã¥Ü¼Æ­È)_0917_samwang³£¬O¥H¦U¦³(²Î)ÃöÁä¦rÀɮתº²Ä5¬q¼Æ¦r§@·j´MÅÞ¿è¡A
¥B¦U³Q·j´MÀɮתºB¡GEÄæ®æ¦¡³£¬Û¦P¡C

½Ð°Ý¡GH_·j´M(²Î)¦rÀÉ(¥DÀÉ_Åã¥Ü¼Æ­È)_0917_samwang¬O§_¯à~¦p¦PH_·j´M(¾÷)¦rÀÉ(¥DÀÉ)_0917_samwang~
¤@¼Ë³£¾A¥Î©ó´ú¸Õ_1894(³æ¼h=0000)©M´ú¸Õ_1894(Âù¼h=0000+0000)¡H

¦pªG¬°§_~
½Ð°Ý¡G´ú¸Õ_1894(³æ¼h=0000)ªºH_·j´M(²Î)¦rÀÉ(¥DÀÉ_Åã¥Ü¼Æ­È)_0917_samwangÀ³¸Ó¦p¦ó­×¥¿¡H

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

TOP

        ÀR«ä¦Û¦b : ¥¬¬I¦p¼½ºØ¡A¥HÅw³ß¤ß´þ¼íºØ¤l¡A¤~·|µoªÞ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD