ªð¦^¦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

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

¦^´_ 1# ziv976688

±N¤U¦Cªº·j´M¶}±Ò±Æ§Ç~¥H¥Ñ¤p¦Ó¤j(¶¶§Ç)§ï¬°¥Ñ¤j¦Ó¤p(­Ë§Ç)¡C
>> ¥u­n§ï¤@¦C¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
'For i1 = 0 To n1 - 1 '¶}±ÒAr1¡Acopy A¡BBÄæ¸ê®Æ¨ìSheet1 MÄæ¶}©l©¹¥k
For i1 = n1 - 1 To 0 Step -1

TOP

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

¦^´_ 4# ziv976688

½Ð°Ý»yªk­n¦p¦ó½s§ï¡H
>> ¦pªþ¥ó¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

H_·j´M(¾÷)¦rÀÉ(¥DÀÉ)_0916_Q.zip (127.92 KB)

TOP

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

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

TOP

¦^´_ 6# ziv976688


EÄæ(­¿²v) =$A$2>0®É¡ADÄ檺­È/$A$2¡F¨Ã½Ð±NEÄæ­È¨ú¤p¼ÆÂI«á3¦ì¼Æ¡A²Ä4¦ì¥|±Ë¤­¤J(=ROUND(D2/$A$2,3))
>> If Arr(i, 3) > 0 Then Arr(i, 4) = Round(Arr(i, 3) / .[A2], 3) 'EÄæ­È½Ð¼W¥[¨ú¤p¼ÆÂI«á3¦ì¼Æ¡A²Ä4¦ì¥|±Ë¤­¤J

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

¦^´_ 9# ziv976688


¤£¦n·N«ä³B²z#4°ÝÃD®É¡A¨S¦³¬Ý«e­±µ{¦¡½X¡Aª½±µ¤Þ¥Î¦r¨å®É¥Î¨ì­«½Æ½s¸¹¡A
¤w­×¥¿§¹¦¨¦pªþ¥ó¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

H_·j´M(¾÷)¦rÀÉ(¥DÀÉ)_0917_samwang.zip (127.16 KB)

TOP

        ÀR«ä¦Û¦b : ¤H¨ÆªºÁ}Ãø»PµZ¿i¡A´N¬O¤@ºØ¦ÒÅç¡C
ªð¦^¦Cªí ¤W¤@¥DÃD