Board logo

標題: [發問] 根據"料號欄"為依據,做排序 [打印本頁]
作者: PJChen    時間: 2021-4-6 02:55     標題: 根據"料號欄"為依據,做排序

大大們好,

請教如下....
來源檔為商品2!新月工作表       
我有許多的檔案都需要根據"料號欄"的料號順序為依據,做排序       
需排序的每個檔的表頭位置,及內容都不太同,       
目的檔排序的準則為整列排序,若有未出現的料號,則略過       
例:        標示黃底,都是目的檔庫存表沒有的品項,則目的檔的這些料號,就略過,跳下個料號繼續排序
        由於目的檔也會有些工作表與料號無關,不需排序,
        所以需排序的工作表,以"新月"M1:M2所指定的起迄工作表作為排序對象
        並且自動找尋表頭有"料號"字樣,就依"新月"的料號順序整列排序

[attach]33169[/attach]
作者: PJChen    時間: 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為起迄,但因為格式不相同,打開檔案後,
除了依工作表起迄作排序,需要能自動找到"料號"字樣的功能,才能依據料號欄作整列排序
作者: 軒云熊    時間: 2021-4-8 16:55

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

回復 1# PJChen
有空幫我試試看是不是你要的結果 會很慢因為迴圈太多了 看看有沒有大大願意幫忙 感謝
  1. Public Sub 跨工作簿比對並移動練習()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Sheets.Copy After:=Sheets(Sheets.Count)
  5.     For X = [H65535].End(3).Row To 1 Step -1
  6.         If IsError(Cells(X, "H")) Then
  7.             Rows(X).Delete
  8.         End If
  9.     Next X
  10.     Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2
  11.    
  12.    
  13.     Set xD = CreateObject("Scripting.Dictionary")
  14.     Arr = Range([A65535].End(3), [A1])
  15.    
  16.     Application.DisplayAlerts = False
  17.     Sheets(Sheets.Count).Delete
  18.     Application.DisplayAlerts = True
  19.    
  20.     For X = 1 To UBound(Arr, 1)
  21.             xD(Arr(X, 1)) = Trim(xD(Arr(X, 1)) & " " & X)
  22.     Next X
  23.     Erase Arr
  24.    
  25.     A = Dir("T:\0_自訂表單\日常表格\*.xlsx")
  26.     Workbooks.Open "T:\0_自訂表單\日常表格\" & A & ""
  27.     Set W = Workbooks("商品2.xlsm").Sheets(1)
  28.    
  29.     For E = 1 To Sheets.Count
  30.         N = Sheets(E).Name: Sheets(E).Activate
  31.         If IsNumeric(N) Then
  32.             If Int(N) > W.[M2] Then Exit For
  33.             If Int(N) >= W.[M1] And Int(N) <= W.[M2] Then
  34.                 Arr = ActiveSheet.UsedRange
  35.                 For X = 1 To UBound(Arr, 1)
  36.                     For Y = 1 To UBound(Arr, 2)
  37.                         If Arr(X, Y) = "料號" Then
  38.                             Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  39.                             GoTo A01
  40.                         End If
  41.                     Next Y
  42.                 Next X
  43. A01:            Y = Y: Erase Arr
  44.                
  45.                 For Each D In xD
  46.                 SR = Split(xD(D), " ")
  47.                     For Each S In SR
  48.                         SInt = Int(S)
  49.                         For Z = UBound(Brr) To 1 Step -1
  50.                         On Error Resume Next
  51.                             If D <> Empty Then
  52.                                 If D = Brr(Z, 1) Then
  53.                                     Rows(Z).Cut
  54.                                     Rows(SInt).Insert , 1
  55.                                     Brr = Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  56.                                     Exit For
  57.                                 End If
  58.                             End If
  59.                         On Error GoTo 0
  60.                         Next Z
  61.                     Next S
  62.                 Next D
  63.         
  64.             End If
  65.         End If
  66.     Next E
  67.    
  68.     Application.ScreenUpdating = True
  69. End Sub
複製代碼
[attach]33172[/attach]
作者: PJChen    時間: 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
作者: 軒云熊    時間: 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


但還是很慢 ..如果資料量大會非常慢... .看看有沒有大大可以幫忙
作者: PJChen    時間: 2021-4-9 22:02

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

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

[attach]33177[/attach]
作者: 軒云熊    時間: 2021-4-10 00:39

回復 6# PJChen

有空再幫我試試看是不是你要的結果謝謝
  1. Public Sub 跨工作簿比對並移動練習0409()
  2.     Application.ScreenUpdating = False
  3.     '新增一個工作表排列後 存到陣列在刪除工作表
  4.     Sheets.Copy After:=Sheets(Sheets.Count)
  5.     Range([A65535].End(3), [A4]).Sort [A4], 1, Header:=2

  7.     Set xD = CreateObject("Scripting.Dictionary")
  8.     Arr = Range([A65535].End(3), [A1])
  9.    
  10.     Application.DisplayAlerts = False
  11.     Sheets(Sheets.Count).Delete
  12.     Application.DisplayAlerts = True
  13. '--------------------------------------------------------
  14.     '把排列後的資料存到字典裡
  15.     For X = 1 To UBound(Arr, 1)
  16.         xD(Arr(X, 1)) = Trim(xD(Arr(X, 1)) & " " & X)
  17.     Next X
  18.     Erase Arr
  19. '--------------------------------------------------------
  20.     '尋找檔案的位置然後開啟
  21.     A = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
  22.     Workbooks.Open ThisWorkbook.Path & "\" & A
  23. '--------------------------------------------------------
  24.     '切換到指定工作表 把含有"料號"的那一欄位置記下來
  25.     Sheets("整月統計").Activate '這裡可以指定要排列的工作表的位置 "整月統計" 或 "3"
  26.     Arr = ActiveSheet.UsedRange
  27.     For X = 1 To UBound(Arr, 1)
  28.         For Y = 1 To UBound(Arr, 2)
  29.             If Arr(X, Y) = "料號" Then
  30.                 Y = Y
  31.                 X = X + 1
  32.                 GoTo A01
  33.             End If
  34.         Next Y
  35.     Next X
  36. A01: Erase Arr
  37. '--------------------------------------------------------
  38.     '尋找比對後並重新排列
  39.     For Each D In xD
  40.         SR = Split(xD(D), " ")
  41.         For Each S In SR
  42.             If D = Empty Then Exit For
  43.             With Range(Cells(1, Y), Cells(Rows.Count, Y).End(3))
  44.                 On Error Resume Next
  45.                 Set C = .Find(D)
  46.                 G = .FindNext(C).Address
  47.                 If C = D Then
  48.                     If Not C Is Nothing Then
  49.                         Rows(C.Row).Cut
  50.                         Set C = .FindNext(G)
  51.                         K = K + 1
  52.                         Rows(X + K).Insert , 1
  53.                     End If
  54.                 End If
  55.                 Application.CutCopyMode = False
  56.                 On Error GoTo 0
  57.             End With
  58.         Next S
  59.     Next D
  60.     Set C = Nothing
  61.    
  62.     Application.ScreenUpdating = True
  63. End Sub
複製代碼
[attach]33179[/attach]
作者: PJChen    時間: 2021-4-11 22:51

回復 7# 軒云熊

熊大好,
反覆測試,它還是無法正確排序,我把正確及錯誤的排列都留在檔案中,
請再幫忙看下....
[attach]33185[/attach]
作者: 軒云熊    時間: 2021-4-12 00:09

回復 8# PJChen


我以為你要重新排列 所以才會加入這段
    '新增一個工作表排列後 存到陣列在刪除工作表
把這些刪除再試試看 是不是你要的結果 感謝
'    Sheets.Copy After:=Sheets(Sheets.Count)
'    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

保留
    Set xD = CreateObject("Scripting.Dictionary")
    Arr = Range([A65535].End(3), [A1])
作者: PJChen    時間: 2021-4-12 00:39

回復 9# 軒云熊
不好意思,排序還是會出錯,
"整月統計"的表頭原來在第3列,為了測試用我把上方隨意增減空白列,現在表頭放在第6列,
結果不但排列錯誤,而且會將原來的表頭第2列,移動到下方....
在偵測"料號"的所在位置時,從料號往上的所有列數,都屬於表頭位置,不能列入排序範圍,
不然表格會大亂....再麻煩您了.
[attach]33189[/attach]
作者: 軒云熊    時間: 2021-4-12 22:19

回復 10# PJChen

我有修改過了  有空再幫我試試看 行不行 感謝

[attach]33193[/attach]
作者: PJChen    時間: 2021-4-12 23:14

回復 11# 軒云熊
熊大好,
我將目前可能會需要排序的工作表都放入一併測試,如下:
1) 所有工作表,排序的資料下半部不正確
2) 工作表更改過表頭(把表頭範圍加大),排序就更不正確

[attach]33194[/attach]
作者: 軒云熊    時間: 2021-4-13 01:13

回復 12# PJChen

改好了 有空再看看是不是你要的結果 感謝
[attach]33196[/attach]
作者: PJChen    時間: 2021-4-13 15:15

回復 13# 軒云熊

熊大好,

1) 印盤點表...這個工作表完全無法排序,我想是因為第一欄是空白,在第一欄key入某些數字後,就可以正常排序,不知這個能夠克服嗎?如果不行,就不改程式了！
2) 另外,無意中發現若在程式中按F5,則程式也不能排序,但按"sorting"鍵時則可排序,不知原因？
作者: 軒云熊    時間: 2021-4-13 22:08

回復 14# PJChen
我也不知道 F5 的問題 >"<     有空在幫我試試看 還有沒有問題 感謝

[attach]33202[/attach]
作者: PJChen    時間: 2021-4-14 23:09

回復 15# 軒云熊
熊大好,
我把程式稍作修改,以便順應我平日正式檔,程式與執行報表是分開的,但修改後程式就停在
b = xB.Sheets(a3).[a1].SpecialCells(xlCellTypeConstants, 23).Column
無法執行,請幫忙看看！
[attach]33205[/attach]
作者: 軒云熊    時間: 2021-4-15 02:05

回復 16# PJChen

可以把要修改的 步驟寫出來
作者: 軒云熊    時間: 2021-4-15 17:08

回復 16# PJChen

有空再幫我試試看 是不是你要的結果 感謝

[attach]33207[/attach]
作者: 軒云熊    時間: 2021-4-15 22:25

回復 16# PJChen

這是有加入多個活頁簿循環和單一活頁簿看要用哪一個  看看這樣行不行 也許可以存成增益集
[attach]33208[/attach]
作者: PJChen    時間: 2021-4-17 21:43

回復 19# 軒云熊
熊大好,
以下問題是用19樓的程式測試的:
1) MsgBox "選取依據資料檔案的位置"
因為我的檔案會有多個工作表,所以除了指定位置外,還必須要可以指定"依據"哪個工作表名稱來排序
2) 待排序的檔案,不一定與程式放在同一目錄下,且也沒有詢問要排序哪個檔,測試時放了2個檔案,都會打開,但只排序其中一個檔,應該要有選取檔案位置功能比較不會出錯
3) 這裡可以指定要排列的工作表的位置"整月統計" 或 "3",
應該是單一工作表排序,但會出現二次詢問,我測試2次輸入不同名稱,結果它只會排第2次輸入的工作表,單個工作表排序,應該只詢問一次就好
4) 多個工作表排序,
會出現1)起 & 2)迄的詢問,然後再出現詢問指定工作表名稱,我將它取消or確定,又會從頭再問一次,才開始執行排序,應該只問起 & 迄就可以了
5) 多個工作表排序,例如指定排2~8,但只會排2~7
6) 另一次測試指定排3~20,其第3個工作表名稱是1,第20個工作表是18,只排了18個,好像每次都不太一樣！
7) 雖然程式中有Application.Calculation = xlCalculationManual
但好像無法很快速排序,是因為排序都是比較慢的嗎?
作者: 軒云熊    時間: 2021-4-18 00:26

本帖最後由 軒云熊 於 2021-4-18 00:33 編輯

回復 20# PJChen
因為有移動每一個要排序的儲存格  所以會比較慢 不然就是要用另一種方法 就是先存在陣列 再貼回去 但顏色我不知道怎麼貼回去
如果顏色沒有差的話 就可以
有空再幫我試試看 是不是這樣的結果感謝
[attach]33217[/attach]
作者: PJChen    時間: 2021-4-18 11:23

本帖最後由 PJChen 於 2021-4-18 11:28 編輯

回復 21# 軒云熊
熊大好,
程式測試:
1) 單一工作表排序 & 多個工作表排序,都會循環問二次同樣問題,能否再簡化?看試否能避開再度詢問
2) 排序速度還是偏慢
3) 我原本放2個圖檔,但不清楚,把它刪除還是會出現,不過解開壓縮檔,比較好看！

[attach]33220[/attach]
作者: PJChen    時間: 2021-4-18 13:53

回復 21# 軒云熊

再補充:
要排序的詢問,只有針對"位置(資料夾)">工作表
並沒有問檔案,如何知道哪個檔要排序?這樣會隨意抓一個檔,
可以:
1) 指定檔案,指定單一工作表排序
2) 指定檔案,&指定連續工作表排序
3) 指定資料夾/*.xlsx&指定連續工作表排序
作者: 軒云熊    時間: 2021-4-18 23:12

本帖最後由 軒云熊 於 2021-4-18 23:13 編輯

回復 23# PJChen

請問 "*.xlsx" 每個活頁簿循環排序的時候 起點的工作表 跟 結束點的工作表  每個活頁簿是固定的嗎?
作者: 軒云熊    時間: 2021-4-18 23:31

回復 23# PJChen
如果是多活頁簿多工作表 那工作表的區間不定的話就會一直出現選擇工作表的區間位置
還是說 只是要 可以選擇要排序的活頁簿 做多工作表排序? 或著是 2個都要?
1.可以選擇 要排序的活頁簿 可以單一也可以多個工作表排序
2.不指定活頁簿 要進行多個活頁簿排序但工作表位置不同 : 指定工作表區間 每換一個活頁簿 就要重新指定工作表區間一次
3.不指定活頁簿 要進行多個活頁簿排序 工作表區間相同
是這樣的結果嗎?
作者: PJChen    時間: 2021-4-18 23:55

回復 25# 軒云熊
熊大,
想想還是不要做得太複雜,就用原來的,指定單一檔案的方法
1) 單一工作表
2) 多個工作表
這樣就好,不過對話框選項,有辦法用我提供的那個方式嗎?
先前測試,程式還不太正常！
作者: 軒云熊    時間: 2021-4-19 21:22

回復 26# PJChen

有空再幫我試試看 是不是這樣的結果感謝

[attach]33224[/attach]
作者: PJChen    時間: 2021-4-20 23:50

回復 27# 軒云熊
熊大好,
我想將依據的工作表改為名稱,才不用一直算第幾個工作表,
但修改後不能運作,停在紅字這一行,請幫忙看下哪裡要再修改?
    wO = xS.[設定!Z2].Value
    If Sh.Name$(wO) Then MsgBox "沒有指定工作表": Ex.Quit: Set Ex = Nothing: Set Sh = Nothing: Exit Sub
    MsgBox """" & "依據" & wO & "工作表排序"
    Set Sh = Ex.Sheets(wO & "") '可以指定"依據"哪個工作表來排序
作者: 軒云熊    時間: 2021-4-21 00:29

回復 28# PJChen


    If IsNumeric(wO) Then MsgBox "沒有指定第幾個工作表": Ex.Quit: Set Ex = Nothing: Set Sh = Nothing: Exit Sub
    MsgBox """" & "依據" & """第" & wO & "個工作表排序"
    Set Sh = Ex.Sheets(wO) '可以指定"依據"哪個工作表來排序
作者: PJChen    時間: 2021-4-25 15:23

回復 29# 軒云熊

熊大好,
修改完後,無法執行,說沒有指定工作表,但儲存格明明有工作表名稱
另外,我把程式移到其他工作表內,跟其他程式放一起,也無法執行,
說是沒有定義,能否也麻煩幫忙看下定莪的部份?
[attach]33252[/attach]
作者: 軒云熊    時間: 2021-4-25 21:51

本帖最後由 軒云熊 於 2021-4-25 22:04 編輯

回復 30# PJChen

第幾個工作表 是 數字   名稱 是 My_Sh_Name$ = [工作表2!E5].Value 已定義為 "文字"
因為名稱 有數字又有文字  1~3 其實是 9~11個工作表  而 "印盤點表" 是第2個工作表  判斷結果會有錯誤 可否改成 統一用第幾個工作表?
這樣 就可以合併使用
作者: 軒云熊    時間: 2021-4-25 22:25

回復 30# PJChen

有空幫試試看 這樣行不行

        '在同一個活頁簿指定單一工作表
        My_Sh_Name$ = [工作表2!E5].Value
        If [工作表2!E9] <> "" Then
            '在同一個活頁簿指定多個工作表 Sheets(1)到 Sheets(N)個
            起點% = [工作表2!E5].Value
            結束點 = [工作表2!E9].Value
            If IsNumeric(起點) And IsNumeric(結束點) Then
                 MsgBox 起點 & "到" & 結束點
            Else
                 MsgBox "未指定工作表位置"
                 Exit Sub
            End If
        End If
作者: 軒云熊    時間: 2021-4-25 22:48

回復 30# PJChen

合併使用 文字 or 數字 都可以
改了幾個地方  有空再幫我試試看 有沒有問題 感謝

[attach]33254[/attach]
作者: 軒云熊    時間: 2021-4-25 23:39

回復 30# PJChen

抱歉這段要改一下 :
        '在同一個活頁簿指定單一工作表
        My_Sh_Name$ = [工作表2!E5].Value
        If [工作表2!E9] <> "" Then
            '在同一個活頁簿指定多個工作表 Sheets(1)到 Sheets(N)個
            起點% = [工作表2!E5].Value
            結束點 = [工作表2!E9].Value
            If 起點 = 0 Then
                MsgBox "未指定工作表位置"
                Exit Sub
            ElseIf IsNumeric(起點) And IsNumeric(結束點) Then
                 MsgBox 起點 & "到" & 結束點
            Else
                 MsgBox "未指定工作表位置"
                 Exit Sub
            End If
        End If
作者: PJChen    時間: 2021-4-26 01:44

回復 34# 軒云熊

熊大好,
當起點是文字時,會出現錯誤,程式不能運作！ [attach]33255[/attach]
另外,程式貼到我平常使用的工作表時,一直出現問題, 一下是沒定義,一下是要with...
各種的問題,完全無法使用,只有當它是單獨一個檔時,才能運作,這能解決嗎?

測試了幾天,我的每個工作表命名大多是文字與數字混合,
要算第x到第x個工作表,好像比較麻煩,文字與數字混合的檔案,
以開始~結束,能否讓它全部視為文字,數字工作表也不一定要數才可以?
可以這樣做嗎?
作者: 軒云熊    時間: 2021-4-26 04:00

本帖最後由 軒云熊 於 2021-4-26 04:11 編輯

回復 35# PJChen
因為 E5 是文字 E9 就不能有內容 : 單一工作表時   E9 就不能有內容
這已經是 合併的判斷了
這段改一下 試試看還有沒有問題 感謝

        '在同一個活頁簿指定單一工作表
        My_Sh_Name$ = [工作表2!E5].Value
        If Not IsNumeric(My_Sh_Name) Then [工作表2!E9] = ""
        If [工作表2!E9] <> "" Then
            '在同一個活頁簿指定多個工作表 Sheets(1)到 Sheets(N)個
            起點% = [工作表2!E5].Value
            結束點 = [工作表2!E9].Value
            If 起點 = 0 Then
                MsgBox "未指定工作表位置"
                Exit Sub
            ElseIf IsNumeric(起點) And IsNumeric(結束點) Then
                 MsgBox 起點 & "到" & 結束點
            Else
                 MsgBox "未指定工作表位置"
                 Exit Sub
            End If
        End If
另外,程式貼到我平常使用的工作表時,一直出現問題, 一下是沒定義,一下是要with...
各種的問題,完全無法使用,只有當它是單獨一個檔時,才能運作,這能解決嗎?
請問  貼到我平常使用的工作表 是甚麼檔案? 可否上傳看一下 感謝
可以用自訂表單 或著 InputBox  然後存成增益集
作者: 軒云熊    時間: 2021-4-26 15:06

回復 35# PJChen

已改成表單方式 在試試看這樣行不行
如果沒問題 可以存成增益集
不需要用的時候再關閉
[attach]33256[/attach]
作者: PJChen    時間: 2021-4-26 17:46

回復 36# 軒云熊
熊大好,

測試結果如下：
1) 已附上平日作業模式的程式檔,還是不能運作
2) 開始 (& 單一排序工作表)設在AZ4/ 結束 設在AZ5
3) 結束 儲存格[AZ5]=0時,就相當於"",所有的欄位因為都有公式,請不要讓它有清除欄位功能
4) 開始 (& 單一排序工作表)/ 結束 的儲存格,無論是否為數字,能有其他寫法,不要用數第x個
For xh = 1 To Sheets.Count
例如：工作表A~工作表8(不是數第8,而是工作表8)
[attach]33257[/attach]
作者: 軒云熊    時間: 2021-4-26 20:12

本帖最後由 軒云熊 於 2021-4-26 20:24 編輯

回復 38# PJChen

確定要用 Micro_2 這個檔案嗎? 如果確定 就要重寫因為大部分需求已經不一樣了
如果只用工作表名稱 就改這樣:
'印盤點表~盤點
For X = 1 To Sheets.Count
    If Sheets(X).Name = "印盤點表" Then
        For X1 = X To Sheets.Count
            Sheets(X1).Activate
            If Sheets(X1).Name = "盤點" Then
                Exit For
            End If
        Next X1
    Exit For
    End If
Next X

請問  Micro_2  的 AV2 是 依據 檔案的路近嗎?
作者: 軒云熊    時間: 2021-4-26 20:35

本帖最後由 軒云熊 於 2021-4-26 20:38 編輯

回復 38# PJChen

可以說清楚 現在的邏輯不然這題會改不完  ^^"
作者: PJChen    時間: 2021-4-26 21:05

回復 39# 軒云熊

熊大,
雖然我換了一個表格,需填入工作表的格子換了位置而已,其餘的並沒有變動,
如果您認為其他的問題需要大量改程式,就不要麻煩了！
只是想知道...
儲存格位置我都修改好了,為何換了一個工作表,程式檔就不能運作?
作者: 軒云熊    時間: 2021-4-26 23:49

本帖最後由 軒云熊 於 2021-4-26 23:59 編輯

回復 41# PJChen
因為 妳的a1是物件 不是變數 如果要指定路近 就不需要選擇位置 要改成類似這樣的寫法
'    A1 = Dir(ThisWorkbook.Path & "\" & "商品2.xlsm")
'    Ex.Workbooks.Open ThisWorkbook.Path & "\" & A1
不麻煩 因為我們是互相幫助 ^_^ 我只是要確認妳要的結果而已
有空再幫我試試看 是不是妳要的結果 感謝

[attach]33258[/attach]
作者: PJChen    時間: 2021-4-27 00:12

回復 42# 軒云熊

熊大,
我沒有要指定路徑,路徑只是自己參考用的,都說了要原寫法,
只是改變3個輸入儲存格位置...而且都修改好了,為何換了一個工作表,程式檔就不能運作?
而且我沒有設定a1,您說的a1是物件 不是變數 ?不理解,我有放什麼物件?
作者: 軒云熊    時間: 2021-4-27 00:16

本帖最後由 軒云熊 於 2021-4-27 00:20 編輯

回復 43# PJChen
這段妳看一下 這是指定義為 活頁簿 物件
Dim a1 As Workbook, xS As Worksheet, Sh As Worksheet, wO$, Arr, xD
作者: PJChen    時間: 2021-4-27 01:17

回復 44# 軒云熊

因為在執行程式過程中,執行一次就出現一個對話框,很多、很多次,所以就一直Dim....
這次的程式最近我想要的,感謝您....



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)