返回列表 上一主題 發帖

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

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

回復 10# stillfish00


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

而第一點,我發現我在簡化上載程式時多刪了一句,實際程式:
  1. With Out
  2. .Columns(1).ColumnWidth = 35
  3. .Range(Out.Cells(1, 2), .Cells(Out.Cells(10000, 1).End(xlUp).Row, .Cells(1, 100).End(xlToLeft).Column)).ColumnWidth = 10
  4. Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
  5. End With
複製代碼
麻煩stillfish00大可以加回「.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1」再試嗎?
這句的目的是簡化顯示,但好像程式有了這句後,即使手動刪除攔 T:ND 重跑,UsedRange.Address 顯示 也不正確.....

TOP

本帖最後由 准提部林 於 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

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

回復 12# 准提部林


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

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


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

temp_v2.zip (91.36 KB)

TOP

回復 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

這可以:
1.刪除舊〔Output〕工作表
2.複製〔TMP〕工作表,重新命名〔Output〕

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

TOP

本帖最後由 小俠客 於 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的完全一樣.....
也有加上大大的
  1. On Error Resume Next
  2. Out.UsedRange.EntireColumn.Delete  '加這行
  3. Out.Cells.Clear
  4. Out.Columns.Ungroup
  5. Out.Cells.EntireColumn.Hidden = False
  6. Out.UsedRange.Delete  '加這行
複製代碼
範本的功能不錯,看來可以一試,謝謝版大。

TOP

本帖最後由 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

回復 15# 小俠客


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

TOP

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

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

TOP

回復 17# lpk187


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

TOP

回復 19# 小俠客

你不覺得奇怪嗎?為什麼每次增的欄和你插入的一樣多嗎?

TOP

        靜思自在 : 小事不做、大事難成。
返回列表 上一主題