如何用VBA 把SUBOROUTINE寫入特定WORKSHEET？ - Excel程式區

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

19^# 跳轉到 »

發表於 2015-10-13 15:11 | 只看該作者

回復 17# lpk187

應該不是，上面stillfish00大大的手動動作沒有加入insert動作，但usedrange仍然出錯
我想應該是stillfish00推論：調整欄闊、GROUP和UNGROUP同時使用後，usedrange便無法重設

TOP

小俠客

中學生 Rank: 2

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

18^#

發表於 2015-10-13 15:08 | 只看該作者

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

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

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 6
精華: 0
積分: 576
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2026-9-10

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

17^#

發表於 2015-10-13 14:00 | 只看該作者

回復 15# 小俠客

因為其中有一句Out.Columns("B:D").Insert 插入儲存格範圍，而一直增加使用區域的！
若試著把這句註解掉，就不會增加了usedrange

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

16^#

發表於 2015-10-13 13:49 | 只看該作者

本帖最後由 stillfish00 於 2015-10-13 13:51 編輯

回復 15# 小俠客
看來是excel的問題，我把手動重現問題步驟描述如下
我也是excel2010，其他版本可試試:
1. 開新工作表
2. 選 B:D 欄，更改欄寬
3. 選 B:D 欄，群組
4. 點選群組左邊的1(第一層)
5. 點選群組左邊的2
6. 取消群組
7. 刪除 B:D 欄
8. VBA 執行 MsgBox ActiveSheet.UsedRange.Address

好像只要有動過群組的欄寬，又去摺疊群組，之後就清不乾淨了(刪除也無效)

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

小俠客

中學生 Rank: 2

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

15^#

發表於 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 '加這行

複製代碼

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

14^#

發表於 2015-10-13 10:10 | 只看該作者

回復 13# 小俠客

我只能測試刪除原有資料及解除群組,
即使用加入:.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Out.UsedRange.Address 也是 $A$1 無誤~~

所謂的〔範本〕，指的是〔工作表範本〕，這表是在同一檔案的，
您可手動新增一工作表，命名為〔TMP〕，將〔Output〕程式碼貼入，即為一範本工作表，

要執行程式時，再〔Call 呼叫〕以下副程式：　
Sub NewOutput()
On Error Resume Next
Application.DisplayAlerts = False
With ThisWorkbook
　　　.Sheets("Output").Delete
　　　.Sheets("TMP").Copy After:=.Sheets(.Sheets.Count)
　　　.Sheets(.Sheets.Count).Name = "Output"
End With
Application.DisplayAlerts = True
End Sub

這可以：
１．刪除舊〔Output〕工作表
２．複製〔TMP〕工作表，重新命名〔Output〕

每次都是完全空白的工作表，也解決Selection_Change程式碼的問題！

TOP

小俠客

中學生 Rank: 2

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

13^#

發表於 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)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

12^#

發表於 2015-10-12 18:35 | 只看該作者

本帖最後由准提部林於 2015-10-12 18:36 編輯

回復 8# 小俠客

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

這邊測都可以的～～

另個作法（範本引用）：　
空白工作表+貼好工作表事件VBA，命名為〔TMP〕，
建立新資料時，刪除舊表，複製此表重命名～～

TOP

小俠客

中學生 Rank: 2

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

11^#

發表於 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 顯示也不正確.....

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

10^#

發表於 2015-10-12 14:23 | 只看該作者

回復 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，只要你多判斷是否是你要觸發的工作表。

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]