請問如何把無資料的多餘頁面設定一按鈕刪除 - Excel程式區

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

1^# 跳轉到 »

發表於 2016-10-9 10:34 | 顯示全部帖子

Sub 匯出地磅資料到新工作表()
Dim vSht As Worksheet, R&, vR As Range, SHN$, xSht As Worksheet
Set vSht = ActiveSheet: SHN = vSht.Name & "匯出"
On Error Resume Next: Set xSht = Sheets(SHN): On Error GoTo 0
If xSht Is Nothing Then Set xSht = Sheets.Add(after:=Sheets(Sheets.Count))
With xSht
.Name = SHN: .Cells.Clear '重命名, 清除內容
R = Val(vSht.[AT51]) * 52: If R = 0 Then Exit Sub '取得頁數
vSht.Range("A1:AM" & R).Copy .[A1] '貼上資料
.Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '序號公式
.Range("A1:AM" & R) = .Range("A1:AM" & R).Value '全部內容貼成值
For Each vR In vSht.[A1:AM1]
.Range(vR.Address).ColumnWidth = vR.ColumnWidth '欄寬
Next
End With
On Error Resume Next
With xSht.Range("AK16:AK" & R)
.SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '刪除〔文字〕格整列
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete '刪除〔空白格〕整列
End With
On Error GoTo 0
xSht.Select
End Sub

複製代碼

Xl0000046.rar (144.56 KB)
　
　

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

2^#

發表於 2016-10-9 17:39 | 顯示全部帖子

沒注意原表公式參照格在複製範圍之外，修改一下：

With xSht
　　　.Name = SHN: .Cells.Clear '重命名, 清除內容
　　　.[BK3] = vSht.[BK3].Value
　　　.[AV1] = vSht.[AV1].Value
　　　.[BI3] = vSht.[BI3].Value
　　　R = Val(vSht.[AT51]) * 52: If R = 0 Then Exit Sub '取得頁數
　　　vSht.Range("A1:AM" & R).Copy .[A1] '貼上資料
　　　.Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '序號公式
　　　.Range("A1:AM" & R) = .Range("A1:AM" & R).Value '全部內容貼成值
　　　For Each vR In vSht.[A1:AM1]
　　　　　.Range(vR.Address).ColumnWidth = vR.ColumnWidth '欄寬
　　　Next
　　　.[BK3] = "": .[AV1] = "": .[BI3] = ""
End With

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

3^#

發表於 2016-10-9 20:03 | 顯示全部帖子

本帖最後由准提部林於 2016-10-9 20:05 編輯

回復 15# simplehope

.SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '刪除〔文字〕格整列
用的是功能表：編輯＞到＞特殊（其它版本可能不同，找看看）　　

因為AK欄有效內容為〔數值〕，所以只要將〔文字〕及〔空格〕整列拿掉，剩下的就是所需：　

使用〔錄製〕就可以取得程式碼（要錄兩次）！　
　
使用這功能時，若選取範圍中沒有文字及空格，程式會發生錯誤而中斷，
所以前面加個　On Error Resume Next （略過程式錯誤繼續執行），
這是已預知下兩行程式可能有錯誤發生前提下所加的，
當那兩行程式執行完畢，必須讓程式恢復〔偵錯〕的功能，
所以再加　On Error GoTo 0　（恢復偵錯），
否則後面的程式若有錯誤將無從得知，也因此可能處理出來的資料並不正確，而無錯誤提示，
上一段的：
On Error Resume Next
Set xSht = Sheets(SHN)　＞　若工作表不存在，預設將提示錯誤，此時提示就略過了
On Error GoTo 0
　
　

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

4^#

發表於 2016-10-9 20:10 | 顯示全部帖子

回復 16# simplehope

公式參照並未帶工作表名稱引數，
因此貼至其它表時，它參照的是本身表的儲存格，
但這表的參照格是空白的，公式值當然是錯誤的！

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

5^#

發表於 2016-10-9 20:15 | 顯示全部帖子

本帖最後由准提部林於 2016-10-9 20:18 編輯

回復 18# simplehope

您第一次是公式原盤貼過來，再貼成值，這就是參照遺失問題，
將原表ＡＶ１改成〔卸櫃〕，再執行您原來程式，
手工去比對兩表Ｎ／Ｐ兩欄計算結果看看！！！

TOP

[發問] 請問如何把無資料的多餘頁面設定一按鈕刪除

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

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