返回列表 上一主題 發帖

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

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
1# 跳轉到 »
發表於 2016-10-9 10:34 | 顯示全部帖子
  1. Sub 匯出地磅資料到新工作表()
  2. Dim vSht As Worksheet, R&, vR As Range, SHN$, xSht As Worksheet

  4. Set vSht = ActiveSheet: SHN = vSht.Name & "匯出"
  5. On Error Resume Next: Set xSht = Sheets(SHN): On Error GoTo 0
  6. If xSht Is Nothing Then Set xSht = Sheets.Add(after:=Sheets(Sheets.Count))

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

  19. On Error Resume Next
  20. With xSht.Range("AK16:AK" & R)
  21.      .SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '刪除〔文字〕格整列
  22.      .SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '刪除〔空白格〕整列
  23. End With
  24. On Error GoTo 0

  26. xSht.Select
  27. End Sub
複製代碼
　
Xl0000046.rar (144.56 KB)
　
　

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
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

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
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

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
4#
發表於 2016-10-9 20:10 | 顯示全部帖子
回復 16# simplehope


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

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
5#
發表於 2016-10-9 20:15 | 顯示全部帖子
本帖最後由 准提部林 於 2016-10-9 20:18 編輯

回復 18# simplehope


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

TOP

        靜思自在 : 不要小看自己，因為人有無限的可能。
返回列表 上一主題