根據"料號欄"為依據,做排序 - Excel程式區

　暱稱: PJ

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

6^# 跳轉到 »

發表於 2021-4-9 22:02 | 只看該作者

回復 5# 軒云熊
不好意思
我原來想得很多,結果程式就變得很複雜,我想改為單純化,只要
1) 依來源檔"商品2"的A欄作為排序依據
2) 以庫存檔的"整月統計"(意思是指定單一工作表就好)",搜尋料號欄來整列排序
3) 庫存檔的料號與來源檔對不上時,一律排在下方
4) 若料號相同,則以來源的料號順序來排序
5) 能否在程式中註解,我想了解程式作用

現在可以排序,但結果是錯誤的,而且會將"整月統計"中表格的最後一列踢到第77列,能否幫忙看看？
我把排序後的正確結果放在"整月統計"

依新月工作表_料號排序.rar (287.38 KB)

TOP

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2024-9-23

5^#

發表於 2021-4-9 00:22 | 只看該作者

回復 4# PJChen

For E = 1 To Sheets.Count
      N = Sheets(E).Name: Sheets(E).Activate
      If IsNumeric(N) Then
         If Int(N) > W.[M2] Then Exit For
         If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then
可以改成
For E = 1 To Sheets.Count
      Sheets(E).Activate
      If E > W.[M2] Then Exit For
      If E >= W.[M1] And E <= W.[M2] Then

這段
For X = [H65535].End(3).Row To 1 Step -1
      If IsError(Cells(X, "H")) Then
         Rows(X).Delete
      End If
Next X
Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

是用 H欄做排序後的依據因為可以排除沒有的資料
或著你可以改成

Sheets.Copy After:=Sheets(Sheets.Count)
For X = [H65535].End(3).Row To 1 Step -1
      If IsError(Cells(X, "A")) Then
         Rows(X).Delete
      End If
Next X
Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2
其實也沒差因為 If D = Brr(Z, 1) Then 已經可以跳過了

我有稍微修改了一下這段

         For Each D In xD
            SR = Split(xD(D), " ")
            For Each S In SR
                  SInt = Int(S)
                  If D = Empty Then Exit For
                  With Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
                     On Error Resume Next
                     Set C = .Find(D)
                     G = .FindNext(C).Address
                     If C = D Then
                        If Not C Is Nothing Then
                              Rows(C.Row).Cut
                              Set C = .FindNext(G)
                              Rows(SInt).Insert , 1
                        End If
                     End If
                     On Error GoTo 0
                  End With
            Next S
         Next D

但還是很慢 ..如果資料量大會非常慢... .看看有沒有大大可以幫忙

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2021-4-8 23:27 | 只看該作者

本帖最後由 PJChen 於 2021-4-8 23:43 編輯

回復 3# 軒云熊
您好,
來源檔指定起迄工作表,這個寫法,會使它去尋找數字工作表,起迄工作表,希望能數第x~第x個工作表,
因為有些工作表是非數字的,請問要怎麼改?
For E = 1 To Sheets.Count
      N = Sheets(E).Name: Sheets(E).Activate
      If IsNumeric(N) Then
         If Int(N) > W.[M2] Then Exit For
         If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then

另外請問,這段如何解讀? 是否為來源檔的H欄? 來源檔除了A欄料號是用來作為排序準則,及M1、M2用來數工作表起迄外,其餘欄位都不能用的！
For X = [H65535].End(3).Row To 1 Step -1
      If IsError(Cells(X, "H")) Then
         Rows(X).Delete
      End If
Next X
Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

TOP

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2024-9-23

3^#

發表於 2021-4-8 16:55 | 只看該作者

本帖最後由軒云熊於 2021-4-8 17:01 編輯

回復 1# PJChen
有空幫我試試看是不是你要的結果會很慢因為迴圈太多了看看有沒有大大願意幫忙感謝

Public Sub 跨工作簿比對並移動練習()
Application.ScreenUpdating = False
Sheets.Copy After:=Sheets(Sheets.Count)
For X = [H65535].End(3).Row To 1 Step -1
If IsError(Cells(X, "H")) Then
Rows(X).Delete
End If
Next X
Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A65535].End(3), [A1])
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
Application.DisplayAlerts = True
For X = 1 To UBound(Arr, 1)
xD(Arr(X, 1)) = Trim(xD(Arr(X, 1)) & " " & X)
Next X
Erase Arr
A = Dir("T:\0_自訂表單\日常表格\*.xlsx")
Workbooks.Open "T:\0_自訂表單\日常表格\" & A & ""
Set W = Workbooks("商品2.xlsm").Sheets(1)
For E = 1 To Sheets.Count
N = Sheets(E).Name: Sheets(E).Activate
If IsNumeric(N) Then
If Int(N) > W.[M2] Then Exit For
If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then
Arr = ActiveSheet.UsedRange
For X = 1 To UBound(Arr, 1)
For Y = 1 To UBound(Arr, 2)
If Arr(X, Y) = "料號" Then
Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
GoTo A01
End If
Next Y
Next X
A01: Y = Y: Erase Arr
For Each D In xD
SR = Split(xD(D), " ")
For Each S In SR
SInt = Int(S)
For Z = UBound(Brr) To 1 Step -1
On Error Resume Next
If D <> Empty Then
If D = Brr(Z, 1) Then
Rows(Z).Cut
Rows(SInt).Insert , 1
Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
Exit For
End If
End If
On Error GoTo 0
Next Z
Next S
Next D
End If
End If
Next E
Application.ScreenUpdating = True
End Sub

複製代碼

商品20408.rar (38.23 KB)

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2021-4-6 23:12 | 只看該作者

本帖最後由 PJChen 於 2021-4-6 23:16 編輯

不好意思,我想我表達得不夠清楚,補充如下：
目的檔的路徑如下,它沒有指定特定檔案,這個路徑底下的所有檔案,都是要以新月的料號欄排序的,
T:\0_自訂表單\日常表格\
檔案打開以後,以"新月"M1:M2所指定的起迄工作表作為排序對象,
EX:
1) 現在我只放一個範例檔"庫存表",以不指定檔名的方式開啟
2) 以"新月"M1:M2所指定的起迄工作表,為2~6,
3) 將庫存表從第2~第6的工作表的料號欄,比對新月的料號欄的順序來排序
4) 新月的料號欄是排序的準則,它的料號比較多,庫存表是要依新月的料號欄順序做排序,當新月的料號欄是目的檔料號欄所沒有的料號,則跳下個料號繼續排序

由於我有許多的檔案都需要同樣的排序方式,但各種檔案格式不相同,但需要排序的工作表,都指定在"新月"M1:M2為起迄,但因為格式不相同,打開檔案後,
除了依工作表起迄作排序,需要能自動找到"料號"字樣的功能,才能依據料號欄作整列排序

TOP

[發問] 根據"料號欄"為依據,做排序

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]