lpk187

回復 20# starry1314

1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
   
2. '
   
3. ' 貼上資料至_業務管理 巨集
   
4. 
   
5.     'Range("A3:P3").Copy
   
6.     sht = ActiveSheet.Name
   
7.     arr = Range("A3:P3")
   
8.     本檔案的路徑 = ThisWorkbook.Path & "\"
   
9.     本檔案的檔名 = ThisWorkbook.Name
   
10.    
    
11.     Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
    
12.     Windows("客戶明細-業務專用.xlsm").Activate
    
13.     AA = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Address
    
14.     EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
    
15.     'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
    
16.     Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
    
17.     'ActiveSheet.Paste Link:=True
    
18.     Windows("客戶明細-業務專用.xlsm").Activate
    
19.     'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
    
20.     Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
    
21.     Workbooks("客戶明細-業務專用.xlsm").Close True
    
22. 
    
23. End Sub

複製代碼

上面是我有修改的程序，其中有解釋路徑

starry1314

回復 21# lpk187


    不好意思~
Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑

此欄一直跑出偵錯,但在前一個尚未修正過的程式 這樣的寫法是正常使用呢

lpk187

回復 22# starry1314


    不好意思，上班中，不能即時回應，也沒好好的檢查程序是否錯誤！抱歉

1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
   
2. '
   
3. ' 貼上資料至_業務管理 巨集
   
4. 
   
5.     'Range("A3:P3").Copy
   
6.     sht = ActiveSheet.Name
   
7.     arr = Range("A3:P3")
   
8.     本檔案的路徑 = ThisWorkbook.Path & "\"
   
9.     本檔案的檔名 = ThisWorkbook.Name
   
10.     日期 = Format([B3], "M""月")
    
11.     Workbooks.Open (ThisWorkbook.Path & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
    
12.     Windows("客戶明細-業務專用.xlsm").Activate
    
13.    
    
14.     EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
    
15.     'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
    
16.     Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
    
17.     'ActiveSheet.Paste Link:=True
    
18.     Workbooks("客戶明細-業務專用.xlsm").Activate
    
19.     'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
    
20.    
    
21.     Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的檔名, SubAddress:=sht '變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
    
22.     Workbooks("客戶明細-業務專用.xlsm").Close True
    
23. 
    
24. End Sub

複製代碼

lpk187

回復 23# lpk187

SubAddress:=sht & "!Q2" 再修改     

starry1314

不會啦~是我才不好意思！一直麻煩你
先慢慢測試再理解囉

lpk187

回復 19# starry1314

Q1.1.Sheets("五月")<請問關於妳所說的變數
假如在個別客戶明細(Q3)做一個清單 一~十二月,那有什麼指令可以讓"五月" 去讀取那個位置變成動態呢?  cells(Q3) 這樣嗎?

回答上面這問題：
A1.之前我有做一個類似的檔案，但因為考慮使用時間的問題(不用每年的一開始就修改程式或更改檔案名稱以及很多相關的問題)，所以我改用資料庫的做法，把像你月份的工作表改成只有用一個資料庫的工作表
然後再做一個可以查詢的工作表來查詢相關的目的，當然我在資料庫有放所謂年度月份的欄位，以利查詢用。
所以像Sheets("五月")做變數，則是要牽涉到使用的目的才能下方法，而我做的巨集是用工作表事件來代替你的按鈕，而且把月份的數字改成阿拉伯數字，這樣則可以用你日期欄來抓取月份來做變數例如
日期 = Format([B3], "M""月")

A2.若在Q3做清單這也是一個好方法，其變數直指它就可以如：xxx=Range("Q3") 或xxx=[Q3]<<這裡要用中括號(你檔案中的第一個巨集用小括號就不對了)，又或是xxx=Cells(3,"Q")，"不是cells(Q3)"

starry1314

Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add
修改過
Workbooks("客戶明細-業務專用.xlsm").Sheets([Q3]).Hyperlinks.Add
這邊要如何轉成變數呢？　上方都換過但還是無法執行~
還是說日期 = Format([B3], "M""月")
我只要再sheets(日期) 這樣嗎?

starry1314

回復 10# lpk187


    請問 Windows("目前所在檔名.xlsm").Activate
可更改為
Windows("ThisWorkbook.Name").Activate 嗎?

stillfish00

回復 27# starry1314
可試試看

1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
   
2. '
   
3. ' 貼上資料至_業務管理 巨集
   
4. '
   
5.     Dim lSourceRow As Long, lTargetRow As Long
   
6.     Dim wsTarget As Worksheet
   
7.    
   
8.     With ActiveSheet
   
9.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
   
10.         Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "B"))) '日期判斷要貼上的工作表
    
11.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '要貼上的位置
    
12.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "B") '複製貼上該行資料
    
13.     End With
    
14.    
    
15.     'Q欄設定超連結到本檔案
    
16.     With wsTarget
    
17.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "Q"), _
    
18.                         Address:=ThisWorkbook.FullName, _
    
19.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
    
20.                         TextToDisplay:=.Cells(lTargetRow, "Q").Text
    
21.     End With
    
22. End Sub
    
23. 
    
24. '工作表用中文字要自己寫function轉，如果是1月、2月...可用 Format(日期,"m月")轉換較方便
    
25. Function GetMonthStr(inDate As Date) As String
    
26.     Select Case Month(inDate)
    
27.         Case 1
    
28.             GetMonthStr = "一月"
    
29.         Case 2
    
30.             GetMonthStr = "二月"
    
31.         Case 3
    
32.             GetMonthStr = "三月"
    
33.         Case 4
    
34.             GetMonthStr = "四月"
    
35.         Case 5
    
36.             GetMonthStr = "五月"
    
37.         Case 6
    
38.             GetMonthStr = "六月"
    
39.         Case 7
    
40.             GetMonthStr = "七月"
    
41.         Case 8
    
42.             GetMonthStr = "八月"
    
43.         Case 9
    
44.             GetMonthStr = "九月"
    
45.         Case 10
    
46.             GetMonthStr = "十月"
    
47.         Case 11
    
48.             GetMonthStr = "十一月"
    
49.         Case 12
    
50.             GetMonthStr = "十二月"
    
51.     End Select
    
52. End Function

複製代碼

starry1314

回復 29# stillfish00


  不好意思~使用結果沒有反應易沒有跳出偵錯.....
另想問一下
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
是滑鼠點擊的所在位置的行數嗎?
還是按鈕所在的行數?