返回列表 上一主題 發帖

[發問] 由小而大改為由大而小的語法研習。

[發問] 由小而大改為由大而小的語法研習。

TEST_0914.rar (227.47 KB)
將下列的搜尋開啟排序~以由小而大(順序)改為由大而小(倒序)。
請問語法要如何編寫?
謝謝!


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("請輸入DATA!的開獎期數", "輸入期數")
num = "100" 'InputBox("請輸入效果檔A︰H複製的期距數範圍", "輸入距期數")
Order = "0" ' InputBox("請輸入增加的邏輯條件條件之起迄序號", "輸入序號(1~99)或不增加(按Enter)")
Ncount = "1" ' InputBox("請輸入驗證版的連續次數", "輸入次數(1~10)")
Sheets("DATA").[L1:L4] = ""

Set fs = CreateObject("Scripting.FileSystemObject")
A = ThisWorkbook.Path     '每個資料夾名稱裝入Ar
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,找同類型資料夾,檔名有"機"裝入Ar1
        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,copy A、B欄資料到Sheet1 M欄開始往右
            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
原來倒序還要多 Step -1才正確。
謝謝您的指導

TOP

本帖最後由 ziv976688 於 2021-9-16 10:25 編輯

回復 2# samwang
TEST_0916.rar (240.68 KB)
不好意思,還有一個"改變欄位的統計邏輯之語法研習"~懇請您賜教 :
請將下列E:K欄位的統計邏輯改為~
E欄(倍率) =$A$2>0時,D欄的值/$A$2;並請將E欄值取小數點後3位數,第4位四捨五入(=ROUND(D2/$A$2,3))
J欄(總次數) =將D欄的值由大而小(倒序)往下填入。
G欄(總個數) =先搜尋D欄與J欄相同值,後將該D欄值在C欄的同列值往下填入。
H欄(排名)=將D欄值以中式排名的排序往下填入。
I欄(數字) =先搜尋D欄與J欄相同值,後將該D欄值在B欄的同列值往下填入。
K欄(倍率) =先搜尋D欄與J欄相同值,後將該D欄值在E欄的同列值往下填入。

請問語法要如何編改?
謝謝您!

        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 '要新增
        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 編輯

回復 5# samwang
您好!
測試OK~完全符合需求
萬分感謝您的指導和幫忙~感恩

TOP

本帖最後由 ziv976688 於 2021-9-16 15:10 編輯

回復 7# samwang
非常謝謝您的補充~感恩

不好意思~如果被搜尋的資料夾名稱第5段有2個(含)以上的不同數字時,會產生偵錯~如圖片~
但是效果檔卻有正確產生
懇請賜正。謝謝您
7C_0_1895期.rar (218.83 KB)

TOP

本帖最後由 ziv976688 於 2021-9-17 01:29 編輯

回復 7# samwang
不好意思~但是效果檔卻有正確產生~說錯了~修正 :
7統_0_1895期_100_1893_2個_1次的效果檔是正確的~
但是7統_0_1895期_100_1894_3個_1次的效果檔之H欄排名不正確(以上述1893檔案的H欄排名再連續[/b])

TOP

本帖最後由 ziv976688 於 2021-9-17 10:51 編輯

回復 10# samwang
不好意思~7統_0_1895期_100_1894_3個_1次的H欄排名還是承續1893的H欄排名。
1893H欄排名=1~13;1894H欄排名=14~24
懇請賜正!謝謝您   

TOP

回復 12# samwang
感謝您的耐心指導~OK了~感恩

不好意思~還有一個需求~敬請指教!謝謝您 !
顯示"V"字改為顯示數值。
TEST_0917.rar (277.26 KB)
目前~H_搜尋(統)字檔(主檔)_0917_Q ~
是將所有有"統"關鍵字的名稱檔案(本題有2個),以其第5段數字由大而小依序開啟後~
統計該檔案D&E二欄的各前3大和前3小(中式排名)之值,並以其在B欄的同列值~
在Sheets("Sheet1")C$1 : AY$1的相同值之C34:AY填入"V"~

需求:
將上述的在Sheets("Sheet1")C$1 : AY$1的相同值之C34:AY填入[b]"V"~
改為
在Sheets("Sheet1")C$1 : AY$1的相同值之C34:AY填入前3大和前3小(中式排名)的該數值。
詳如範例附檔

以上 懇請賜教! 謝謝您!

TOP

回復 14# samwang
samwang大大 :
測試結果 : 完全符合需求
萬分感激您肯跟題耐心指導和熱心幫忙~受惠良多~感恩

TOP

回復 14# samwang
不好意思,有個小問題,請您指教~謝謝您!

當資料夾名稱=7C_0_1894期_100_1845-1893_10+1796-1892_10_1次_1-49內的各檔案:
以H_搜尋(機)字檔(主檔)_0917_samwang執行~產生下列共5個的有(統)關鍵字的檔案~
7統_0_1894期_100_1889_2個_1次~7統_0_1894期_100_1893_2個_1次

再以H_搜尋(統)字檔(主檔_顯示數值)_0917_samwang執行後~
產生7前3大&小_0_1894期_5個_1次的效果檔是OK的。
EX:附件範例~測試_1894(雙層=0000+0000)
測試_1894(雙層=0000+0000).rar (302.5 KB)

當資料夾名稱= 7C_0_1894期_100_1874-1893_10_1次_1-49內的各檔案:
以H_搜尋(機)字檔(主檔)_0917_samwang執行~產生下列共5個的有(統)關鍵字的檔案~
7統_0_1894期_100_1889_1個_1次~7統_0_1894期_100_1893_1個_1次

再以H_搜尋(統)字檔(主檔_顯示數值)_0917_samwang執行後~
在程式碼列68會產生偵錯~詳如圖片。

EX:附件範例~測試_1894(單層=0000)
測試_1894(單層=0000).rar (229.94 KB)

綜上所述:
H_搜尋(統)字檔(主檔_顯示數值)_0917_samwang都是以各有(統)關鍵字檔案的第5段數字作搜尋邏輯,
且各被搜尋檔案的B:E欄格式都相同。

請問:H_搜尋(統)字檔(主檔_顯示數值)_0917_samwang是否能~如同H_搜尋(機)字檔(主檔)_0917_samwang~
一樣都適用於測試_1894(單層=0000)和測試_1894(雙層=0000+0000)?

如果為否~
請問:測試_1894(單層=0000)的H_搜尋(統)字檔(主檔_顯示數值)_0917_samwang應該如何修正?

以上  懇請賜教!  謝謝您!

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題