返回列表 上一主題 發帖

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

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-10-24 11:35 | 顯示全部帖子

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

請教大大,

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

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
2#
發表於 2012-10-24 16:56 | 顯示全部帖子
回復 2# GBKEE

謝謝G大,

成功了!!

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
3#
發表於 2012-10-25 08:59 | 顯示全部帖子
回復 4# c_c_lai
當檔案放在同一資料夾時,這樣確實也是一種方便的作業方法, 謝謝你的巧思!

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
4#
發表於 2012-11-2 23:29 | 顯示全部帖子
回復 2# GBKEE

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


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

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
5#
發表於 2012-11-3 23:40 | 顯示全部帖子
回復 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

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
6#
發表於 2012-11-5 17:42 | 顯示全部帖子
回復 9# GBKEE
謝謝大大,

這樣執行OK.

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
7#
發表於 2012-11-5 20:49 | 顯示全部帖子
回復 13# c_c_lai


Hi,

我無法理解
        .Height = 150
        .Width = 150
        .Cut

的意思,可以幫忙解釋嗎?

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
8#
發表於 2012-11-8 18:07 | 顯示全部帖子
回復 9# GBKEE

大大,

上次程式確認可執行後,我將它應用到其他"TXT"巨集中,出現"陣列索引超出範圍"的對話框,我將將案上傳,可否幫忙看看?
貼簽名__指定儲存格內的檔名為對象.zip (92.11 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
9#
發表於 2012-11-10 13:53 | 顯示全部帖子
回復 9# GBKEE

大大,

我試著修改了一部份程式,程式的用意在以"貼簽名.xlsm"的"EX" sheet的指定儲存格D3內的檔名,執行"TXT"的巨集,現在它可以執行巨集,但出現了個錯誤,可否幫忙指點? ..先謝謝了.
程式執行時,應該將 Shipping for ACE.xlsx的"Booking" sheet的資料copy 到TXT中,現在它雖然做到了,可是連同"貼簽名.xlsm"的"EX" sheet也有copy的動作(整著工作表出現copy後的虛線閃動),我該如何修改,讓它不要執行不正確的copy動作?

以下是修改完後的程式:
  1. Sub txt()
  2. With Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)  '改這裡...
  3. 'Creat a TXT
  4. With .Sheets("Booking")
  5. Cells.Select
  6. Selection.Copy
  7. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  8. :=False, Transpose:=False
  9. Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
  10. Dim S As Variant, xS As Variant
  11. Application.ScreenUpdating = False
  12. End With
  13. End With

  15. With Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)  '改這裡...
  16. Set Rng(1) = .Sheets("Booking").[B1:B45] 'Rng(1) 工作表要複製的範圍
  17. Set Rng(2) = .Sheets("Booking").[A1] 'Rng(2) 存檔名稱的儲存格
  18. Rng(2) = Rng(2) & "_" & Rng(2).Offset(1) & "_" & Rng(2).Offset(2) 'Rng(2) 存檔檔名須多加[A2]的儲存格名稱
  19. End With

  21. Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件 提供對電腦檔案系統的存取。
  22. Set A = Fs.CreateTextFile("P:\TXT\" & Rng(2) & ".txt", True) '建立文字檔案

  24. Debug.Print Rng(1).Cells(27)  'Debug.Print :即時運算視窗 可見到 RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160"
  25. Rng(1).Replace ChrW(160), ""   '消除不可字元 160

  27. For Each E In Rng(1) '依序處裡複製範圍的儲存格
  28. S = Split(E, Chr(10))
  29. If UBound(S) > -1 Then '***有換行 的文字
  30. For Each xS In S
  31. A.WriteLine (xS) '儲存格寫入文字檔
  32. Next
  33. Else
  34. A.WriteLine (E.Text) '儲存格寫入文字檔
  35. End If
  36. Next
  37. A.Close

  39. Shell "Cmd /c start P:\TXT\" & Rng(2) & ".txt" '自動打開TXT檔
  40. Application.ScreenUpdating = True

  42. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
10#
發表於 2012-11-10 16:08 | 顯示全部帖子
回復 9# GBKEE
G大似乎不在家, 不知有人可以幫助我嗎?
我再次修改了程式,發現了另一個問題:("貼簽名.xlsm").Worksheets("EX").Range("D3")的指定檔案若未關閉,則每執行巨集一次,存成TXT的檔名Arctic_USA就會重複一次!
  1. Sub txt()

  3. Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value).Activate '先移到這活頁簿
  4. 'Creat a TXT
  5. With Sheets("Booking").Activate
  6. Cells.Select
  7. Selection.Copy
  8. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  9. :=False, Transpose:=False
  10. Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
  11. Dim S As Variant, xS As Variant
  12. Application.ScreenUpdating = False
  13. End With

  15. With Workbooks(Workbooks("貼簽名.xlsm").Worksheets("EX").Range("D3").Value)  '改這裡...
  16. Sheets("Booking").Select  '這句有無,結果都相同
  17. Set Rng(1) = .Sheets("Booking").[B1:B45] 'Rng(1) 工作表要複製的範圍
  18. Set Rng(2) = .Sheets("Booking").[A1] 'Rng(2) 存檔名稱的儲存格
  19. Rng(2) = Rng(2) & "_" & Rng(2).Offset(1) & "_" & Rng(2).Offset(2) 'Rng(2) 存檔檔名須多加[A2]的儲存格名稱
  20. End With

  22. Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件 提供對電腦檔案系統的存取。
  23. Set A = Fs.CreateTextFile("P:\TXT\" & Rng(2) & ".txt", True) '建立文字檔案

  25. Debug.Print Rng(1).Cells(27)  'Debug.Print :即時運算視窗 可見到 RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160"
  26. Rng(1).Replace ChrW(160), ""   '消除不可字元 160

  28. For Each E In Rng(1) '依序處裡複製範圍的儲存格
  29. S = Split(E, Chr(10))
  30. If UBound(S) > -1 Then '***有換行 的文字
  31. For Each xS In S
  32. A.WriteLine (xS) '儲存格寫入文字檔
  33. Next
  34. Else
  35. A.WriteLine (E.Text) '儲存格寫入文字檔
  36. End If
  37. Next
  38. A.Close

  40. Shell "Cmd /c start P:\TXT\" & Rng(2) & ".txt" '自動打開TXT檔
  41. Application.ScreenUpdating = True

  43. End Sub
複製代碼

TOP

        靜思自在 : 要比誰更受誰．不要比誰更怕誰。
返回列表 上一主題