[發問] 指定D3儲存格,執行排序

PJChen

請教大大,

我在工作表sorting.xlsm的D3儲存格輸入一個工作表名稱(因為需排序的工作表有很多,想用動態方法),以指定D3工作表名稱執行排序的巨集程式,但一直無法運作,
上傳附件,可否指點錯誤!
排序.zip (98.38 KB)

下載次數: 16

2012-10-24 11:32

GBKEE

回復 1# PJChen
試試看

1. Sub sorting()
   
2.       Workbooks(Workbooks("sorting.xlsm").Worksheets("排序").Range("D3").Value).Activate '先移到這活頁簿
   
3.       ''''''    .Activate '要解碼的工作表改成在D3輸入
   
4.     With ActiveSheet          ' With 改在這試試看
   
5.         Set b = .Range("R4").CurrentRegion
   
6.     '  其餘2007 屬性方法 2003 中無法使用
   
7.     '

複製代碼

PJChen

回復 2# GBKEE

謝謝G大,

成功了!!

c_c_lai

回復 3# PJChen
依據GBKEE大大的程式碼也可以修改成：

1. Sub sorting()
   
2.     Dim Wb As Workbook
   
3.    
   
4.     '  Workbooks(Workbooks("sorting.xlsm").Worksheets("排序").Range("D3").Value).Activate
   
5.     '  要解碼的工作表改成在D3輸入，執行時一併要同時開啟 2012 BCMart Chart-Adam 20121023.xls
   
6.     '  下列修正為執行 sorting.xlsm 時， 系統會自動連同將 2012 BCMart Chart-Adam 20121023.xls 一併同時開啟。
   
7.     Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & Workbooks("sorting.xlsm").Worksheets("排序").Range("D3").Value)
   
8.    
   
9.     With Wb.ActiveSheet
   
10.         Set b = .Range("R4").CurrentRegion
    
11.         A = Array("R", "S", "T", "Q", "D")
    
12.         .AutoFilter.Sort.SortFields.Clear
    
13.         For i = 0 To 4
    
14.            .AutoFilter.Sort.SortFields.Add Key:=b.Columns(A(i)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
15.         Next
    
16.         With .AutoFilter.Sort
    
17.             .Header = xlYes
    
18.             .MatchCase = False
    
19.             .Orientation = xlTopToBottom
    
20.             .SortMethod = xlPinYin
    
21.             .Apply
    
22.         End With
    
23.     End With
    
24. End Sub

複製代碼

PJChen

回復 4# c_c_lai
當檔案放在同一資料夾時,這樣確實也是一種方便的作業方法, 謝謝你的巧思!

PJChen

回復 2# GBKEE

大大,
我想將指定儲存格的idea依樣畫葫蘆應用到簽名上,
在"貼簽名.xlsm"的"EX" sheet的指定儲存格D3/ G3內的檔名,執行"貼簽名"的動作,但一直出現錯誤

下載 (22.54 KB)

2012-11-2 23:27

巨集程式也附上,可否幫忙看看? 感謝!
貼簽名__指定儲存格內的檔名為對象.zip (129.63 KB)

下載次數: 6

2012-11-2 23:29

GBKEE

回復 6# PJChen
請詳看 註解

1. Sub copy_signed()
   
2.     Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value).Activate '先移到這活頁簿
   
3.     '***不用先移到這活頁簿:這程式是在Workbooks("貼簽名.xlsm").Worksheets("EX")中呼叫所以是多餘的程式碼.
   
4.     Dim Rng(1 To 3) As Range, xi As Integer
   
5.     Workbooks("貼簽名.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
   
6.     With ActiveSheet          '**可註解掉   '***  With 改在這試試看  <= 不是告訴你改一改  ****
   
7.     .Activate                 '**可註解掉
   
8.     With Workbooks("Shipping for ACE.xlsx")  '***改一改成這樣:前面的With ActiveSheet就沒作用
   
9.                 '*** .Sheets("PKG") 這點在 With ActiveSheet 是錯誤的 一樣都是工作表
   
10.         Set Rng(1) = .Sheets("PKG").[r:r].Find("B. C. MART COMPANY LTD.", LOOKAT:=xlPart).Offset(2, -2)
    
11.                         '** 原是指定[S:S]會搜索不到的   **
    
12.         Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, -2)
    
13.         Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(1, 1)
    
14.        End With
    
15.         For xi = 1 To 3
    
16.             Rng(xi).Parent.Activate
    
17.             Rng(xi).Activate
    
18.             ActiveSheet.Paste
    
19.         Next
    
20.     End With  '** 可註解掉
    
21. End Sub

複製代碼

PJChen

回復 7# GBKEE

大大,

程式修改以後為以下,但我不是我的原意,我希望將程式中的("Shipping for ACE.xlsx") 替換掉,要如何以"貼簽名.xlsm"的"EX" sheet的指定儲存格D3/ G3內的檔名,取代程式中的檔名With Workbooks("Shipping for ACE.xlsx")  ?

Sub copy_signed()
    Dim Rng(1 To 3) As Range, xi As Integer
    Workbooks("貼簽名.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
    With Workbooks("Shipping for ACE.xlsx")  '***改一改成這樣:前面的With ActiveSheet就沒作用
        Set Rng(1) = .Sheets("PKG").[r:r].Find("B. C. MART COMPANY LTD.", LOOKAT:=xlPart).Offset(2, -2)
        Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, -2)
        Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(1, 1)
       End With
        For xi = 1 To 3
            Rng(xi).Parent.Activate
            Rng(xi).Activate
            ActiveSheet.Paste
        Next
    End Sub

GBKEE

回復 8# PJChen
是這樣嗎?

1. Sub copy_signed()
   
2.     Dim Rng(1 To 3) As Range, xi As Integer
   
3.     Workbooks("貼簽名.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
   
4.     With Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)  '改這裡...
   
5.         Set Rng(1) = .Sheets("PKG").[r:r].Find("B. C. MART COMPANY LTD.", LOOKAT:=xlPart).Offset(2, -2)
   
6.         Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, -2)
   
7.         Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(1, 1)
   
8.         For xi = 1 To 3
   
9.             Rng(xi).Parent.Activate
   
10.             Rng(xi).Activate
    
11.             ActiveSheet.Paste
    
12.         Next
    
13.     End With
    
14. End Sub

複製代碼

c_c_lai

回復 8# PJChen
回復 9# GBKEE
上半部如改成如下，個人覺得會方便多。

1. Sub copySigned()    ' GBKEE
   
2.     Dim Rng(1 To 3) As Range, xi As Integer, Wb As Workbook
   
3.    
   
4.     Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)
   
5.    
   
6.     Workbooks("貼簽名.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
   
7.     '   With Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)        '    改這裡...
   
8.     With Wb
   
9.          .
   
10.          .
    
11.     End With
    
12.          .

複製代碼

GBKEE 大大，順便請教，如果 "Picture 1"、"Picture 2" 我是在該目錄下存成兩個 .JPG 或是 .BMP 檔，
那又該如何叫進來呢？ 謝謝您！