[發問] 如何用VBA 把SUBOROUTINE寫入特定WORKSHEET？

小俠客

其實我有兩個問題想了解：

1) 如何能重設一個工作表的usedrange.address？
我寫的程式大概流程是：「清除某一工作表資料」>「寫入資料(當中會插入數個欄位)」>「在有資料的位置再作處理(usedrange)」。
但運行很多次後我發現，即使我的資料只是由A1:Q100，該工作表的usedrange.address變得很大(A1:ZQ100)，我猜是之前的插入欄位動作而影響。但無論我是用cells.delete或cells.clear，usedrange.address 都無法重設成我有資料的range，使程式運行得越來越慢。

由於我無法解決usedrange.address的錯誤，所以我改了程式，由「清除某一工作表資料」變成「刪除該工作表再重新加入同名字的工作表」，usedrange的問題算是解決了，但我又產生另一個問題
2) 如何用VBA 把SUBOROUTINE寫入特定WORKSHEET？
因為該工作表早已寫入一些subroutine，但刪除工作表時卻同時把工作表下的subroutine刪掉，請問有沒有方法加回那些subroutine?

問題實在奇怪，先謝謝大家。

GBKEE

回復 1# 小俠客


   

但無論我是用cells.delete或cells.clear，usedrange.address 都無法重設成我有資料的range

不太了解....你的問題

1. Sub Ex()
   
2.     Application.VBE.Windows("即時運算").Visible = True
   
3.     With Cells
   
4.         .Range("A1:Q100") = "TEST"
   
5.         Debug.Print UsedRange.Address
   
6.         .Clear
   
7.         Debug.Print UsedRange.Address
   
8.     End With
   
9. End Sub

複製代碼

小俠客

回復  小俠客


   
不太了解....你的問題
GBKEE 發表於 2015-10-11 14:43

    由於我無法運行你的代碼，所以我把代碼改成：

1. Sub Ex()
   
2.     With ActiveSheet
   
3.         Debug.Print "1：　"＆.UsedRange.Address
   
4.         .Range("A1:Q100") = "TEST"
   
5.         Debug.Print "２：　"＆.UsedRange.Address
   
6.         .Cells.Clear
   
7.         Debug.Print "３：　"＆.UsedRange.Address
   
8.         .Cells.Delete
   
9.         Debug.Print "４：　"＆.UsedRange.Address
   
10.     End With
    
11. End Sub

複製代碼

結果是：
１：　$A$1:$AL$130
２：　$A$1:$AL$130
３：　$C$1:$AL$1
４：　$C$1:$AL$1

其實第一個「１：　$A$1:$AL$130」也是錯，因為那工作表中只在A1:Q130有資料，而每次我重寫資料時都用「Cells.Clear」把舊資料刪掉，但「UsedRange.Address」好像無法找到正確結果($A$1)。

題外話：我發覺EXCEL在重複使用「With QueryTables.Add」多次(約100次以上)後，每次匯入的時間都會減慢，無論我重新開啟EXCEL或重啟電腦，甚至把該工作表當中因匯入而產生的named range刪掉，匯入時間仍然很慢，不知道原因......

小俠客

對不起，我發現了問題，我相信是GROUP問題，如果不用GROUPING，好像usedrange.address便正常了
但我的程式也有用.Columns.Ungroup，可是問題仍然出現......

1. Sub Integrate()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. 
   
5. Out.Cells.Clear
   
6. Out.Columns.Ungroup
   
7. Out.Cells.EntireColumn.Hidden = False
   
8.   
   
9. For i = 0 To 5
   
10. 
    
11.     Out.Columns("B:D").Insert
    
12.     Out.Columns("C:D").Columns.Group
    
13.     Out.Cells(1, 2) = i & " / FY"
    
14.     Out.Cells(1, 3) = i & " / 2H"
    
15.     Out.Cells(1, 4) = i & " / 1H"
    
16.    
    
17.     With RecordsetA
    
18.         .MoveFirst
    
19.         
    
20.         Do Until .EOF
    
21.             Out.Cells(.Fields("Item_ID"), 2) = .Fields("FY").Value
    
22.             Out.Cells(.Fields("Item_ID"), 3) = .Fields("Second_Half").Value
    
23.             Out.Cells(.Fields("Item_ID"), 4) = .Fields("First_Half").Value
    
24.             Out.Rows(.Fields("Item_ID")).NumberFormatLocal = .Fields("Format")
    
25.             .MoveNext
    
26.         Loop
    
27.        
    
28. 
    
29.     End With
    
30. next i
    
31. 
    
32. ConfigCN.Close
    
33. Set ConfigCN = Nothing
    
34. Set RecordsetA= Nothing
    
35. 
    
36. Application.ScreenUpdating = True
    
37. 
    
38. End Sub

複製代碼

小俠客

回復 2# GBKEE

1. Sub Integrate()
   
2. 
   
3. Set out = ActiveSheet
   
4. 
   
5. Application.ScreenUpdating = False
   
6. 
   
7. Debug.Print out.UsedRange.Address
   
8. On Error Resume Next
   
9. 
   
10. out.Cells.Clear
    
11. out.Columns.Ungroup
    
12. out.Cells.EntireColumn.Hidden = False
    
13.   
    
14. Debug.Print out.UsedRange.Address
    
15. For i = 0 To 5
    
16. 
    
17.     out.Columns("B:D").Insert
    
18.     out.Columns("C:D").Columns.Group
    
19.     out.Cells(1, 2) = i & " / FY"
    
20.     out.Cells(1, 3) = i & " / 2H"
    
21.     out.Cells(1, 4) = i & " / 1H"
    
22. 
    
23. Next i
    
24. 
    
25. Application.ScreenUpdating = True
    
26. 
    
27. End Sub

複製代碼

這個代碼能夠重現usedrange的問題，是我的弄錯嗎？

准提部林

試試看：
Sub AR1011()
ActiveSheet.UsedRange.EntireColumn.Delete　'欄群組也一併取消
ActiveSheet.UsedRange.EntireRow.Delete　'列群組也一併取消
ActiveSheet.UsedRange.Delete　'此時，UsedRange 仍未釋放，再 Del 一次

MsgBox ActiveSheet.UsedRange.Address
End Sub

註：若欄列有隱藏（非群組的隱藏），還須再加指令使其顯示

stillfish00

因為該工作表早已寫入一些subroutine，但刪除工作表時卻同時把工作表下的subroutine刪掉，請問有沒有方法加回那些subroutine?

這問題怪怪的，subroutine會寫在工作表下通常表示只有該工作表會用到，自然刪掉也無所謂；
如果是要給所有工作表都能用的sub，寫在一般模組就好了。

題外話：我發覺EXCEL在重複使用「With QueryTables.Add」多次(約100次以上)後，每次匯入的時間都會減慢

用QueryTables會建立連線，如果只是用來取得資料，不需要保持連線，取完後就馬上刪除連線吧
你可以檢查 資料>連線 裡是不是很多不必要的連線。

*usedrange 抓不到要的範圍，附檔會比較容易找問題；不然就依資料情況看能否採用currentRegion 或其他定位的方法

小俠客

回復 6# 准提部林


    謝謝版大幫忙，可惜我用了你的代碼還是無法解決問題...

現上傳了簡化了的程式
壓縮檔中的ACCESS檔是存放資料，大家可以開啟TEST檔，按short cut 「CTRL+Q」執行程式，之後輸入「1」便可以了，程式最後會顯示usedrange.address
為了減少檔案容量，所以CODE 1以外的資料都刪去......

小俠客

回復 7# stillfish00


    我也明白這個問題是怪怪，但刪除工作表是我解決usedrange.address錯誤的另類方法，可惜我在該工作表寫了selection change的subroutine，刪工作表時會把subroutine刪掉.....

「用QueryTables會建立連線，如果只是用來取得資料，不需要保持連線，取完後就馬上刪除連線吧
你可以檢查 資料>連線 裡是不是很多不必要的連線。」

這個可能是吧，我的白痴解決方法是...... 定期刪掉該工作表再重新建立.......
請問如何用VBA把工作表的連線刪掉？

「*usedrange 抓不到要的範圍，附檔會比較容易找問題；不然就依資料情況看能否採用currentRegion 或其他定位的方法」
已在8樓上傳了檔案，煩請查看

stillfish00

回復 9# 小俠客
1. 附檔手動刪除攔 T:ND 重跑，UsedRange.Address 就會顯示 $A$1:$S$31
    或是 MsgBox Out.UsedRange.Address 也可以改為
    With Out
        MsgBox .Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column)).Address
    End With

2. 先手動刪除那些不用的連線
    在你用 QueryTable 的程式碼(附件沒有我找不到) , refresh 後面加一行 delete
    With ActiveSheet.QueryTables.Add(XXX)
        ..........
        .Refresh BackgroundQuery:=False
        .Delete
    End With

3. selection change 是工作表事件，那些 code 也能移植到 ThisWorkbook 的 Workbook_SheetSelectionChange，只要你多判斷是否是你要觸發的工作表。