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

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

2^#

發表於 2015-10-11 15:18 | 顯示全部帖子

回復小俠客

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

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

Sub Ex()
With ActiveSheet
Debug.Print "1：　"＆.UsedRange.Address
.Range("A1:Q100") = "TEST"
Debug.Print "２：　"＆.UsedRange.Address
.Cells.Clear
Debug.Print "３：　"＆.UsedRange.Address
.Cells.Delete
Debug.Print "４：　"＆.UsedRange.Address
End With
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刪掉，匯入時間仍然很慢，不知道原因......

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

3^#

發表於 2015-10-11 16:19 | 顯示全部帖子

本帖最後由小俠客於 2015-10-11 16:32 編輯

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

Sub Integrate()
Application.ScreenUpdating = False
Out.Cells.Clear
Out.Columns.Ungroup
Out.Cells.EntireColumn.Hidden = False
For i = 0 To 5
Out.Columns("B:D").Insert
Out.Columns("C:D").Columns.Group
Out.Cells(1, 2) = i & " / FY"
Out.Cells(1, 3) = i & " / 2H"
Out.Cells(1, 4) = i & " / 1H"
With RecordsetA
.MoveFirst
Do Until .EOF
Out.Cells(.Fields("Item_ID"), 2) = .Fields("FY").Value
Out.Cells(.Fields("Item_ID"), 3) = .Fields("Second_Half").Value
Out.Cells(.Fields("Item_ID"), 4) = .Fields("First_Half").Value
Out.Rows(.Fields("Item_ID")).NumberFormatLocal = .Fields("Format")
.MoveNext
Loop
End With
next i
ConfigCN.Close
Set ConfigCN = Nothing
Set RecordsetA= Nothing
Application.ScreenUpdating = True
End Sub

複製代碼

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

4^#

發表於 2015-10-11 16:45 | 顯示全部帖子

回復 2# GBKEE

Sub Integrate()
Set out = ActiveSheet
Application.ScreenUpdating = False
Debug.Print out.UsedRange.Address
On Error Resume Next
out.Cells.Clear
out.Columns.Ungroup
out.Cells.EntireColumn.Hidden = False
Debug.Print out.UsedRange.Address
For i = 0 To 5
out.Columns("B:D").Insert
out.Columns("C:D").Columns.Group
out.Cells(1, 2) = i & " / FY"
out.Cells(1, 3) = i & " / 2H"
out.Cells(1, 4) = i & " / 1H"
Next i
Application.ScreenUpdating = True
End Sub

複製代碼

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

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

5^#

發表於 2015-10-12 11:59 | 顯示全部帖子

本帖最後由小俠客於 2015-10-12 12:09 編輯

回復 6# 准提部林

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

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

temp.zip (91.63 KB)

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

6^#

發表於 2015-10-12 12:06 | 顯示全部帖子

回復 7# stillfish00

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

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

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

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

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

7^#

發表於 2015-10-12 17:49 | 顯示全部帖子

本帖最後由小俠客於 2015-10-12 17:50 編輯

回復 10# stillfish00

關於第2、3點，我回去再試試，謝謝

而第一點，我發現我在簡化上載程式時多刪了一句，實際程式：

With Out
.Columns(1).ColumnWidth = 35
.Range(Out.Cells(1, 2), .Cells(Out.Cells(10000, 1).End(xlUp).Row, .Cells(1, 100).End(xlToLeft).Column)).ColumnWidth = 10
Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
End With

複製代碼

麻煩stillfish00大可以加回「.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1」再試嗎？
這句的目的是簡化顯示，但好像程式有了這句後，即使手動刪除攔 T:ND 重跑，UsedRange.Address 顯示也不正確.....

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

8^#

發表於 2015-10-13 09:15 | 顯示全部帖子

本帖最後由小俠客於 2015-10-13 09:18 編輯

回復 12# 准提部林

版大，很抱歉，我在簡化上載程式時多刪了一句：「.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1」，我還是重新上載程式給各位大大指教......

有了這一句後，用了你提議的代碼也解決不了usedrange.address錯誤的問題

至於範本作法，我沒曾使用過範本，還以為範本需要在同一電腦使用，而我需要在不同電腦使用，要再爬文看看，先謝了。

temp_v2.zip (91.36 KB)

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

9^#

發表於 2015-10-13 12:10 | 顯示全部帖子

本帖最後由小俠客於 2015-10-13 12:16 編輯

回復 14# 准提部林

奇怪了，如果是用TEMP_V2的檔案，
第一次執行程式，輸入「1」，MSG是「$A1:$T$31」
再按「CTRL+Q」，輸入「1」，MSGBOX 是「$A1:$AK$31」
再按「CTRL+Q」，輸入「1」，MSGBOX 是「$A1:$BC$31」
但我預期的MSGBOX是「$A$1:$S$31」，因為只有$A$1:$S$31才有資料嘛.....

我是用OFFICE 2010，為什麼會有不一樣的結果？
我把我的測試POST在YOUTUBE，請大家看看：
https://www.youtube.com/watch?v=deM3JvNEeuY&feature=youtu.be
代碼是和temp_v2的完全一樣.....
也有加上大大的

On Error Resume Next
Out.UsedRange.EntireColumn.Delete '加這行
Out.Cells.Clear
Out.Columns.Ungroup
Out.Cells.EntireColumn.Hidden = False
Out.UsedRange.Delete '加這行

複製代碼

範本的功能不錯，看來可以一試，謝謝版大。

帖子: 83
主題: 17
精華: 0
積分: 105
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2010-12-28
最後登錄: 2018-8-8

10^#

發表於 2015-10-13 15:08 | 顯示全部帖子

回復 16# stillfish00
原來如此，如果真是EXCEL的BUG，那麼我們也沒有方法重設usedrange，唯有另行他法
大大提議的Workbook_SheetSelectionChange或版大提議的範本好像可行，只要我把CODE放在WORKBOOK，每次把舊的OUTPUT刪掉便可以
另外，QUERYTABLE加了.delete好像真的變快了，我再不用定期刪除WORKSHEET了.....

最後還是謝謝大家的協助~