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

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

21^# 跳轉到 »

發表於 2016-10-9 20:15 | 只看該作者

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

回復 18# simplehope

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

22^#

發表於 2022-12-12 15:19 | 只看該作者

回復 14# 准提部林

謝謝 simplehope前輩發表此主題與範例
謝謝准提部林前輩指導
後學在此帖學到很多知識,心得註解如下,請再指導,謝謝

Option Explicit
Sub 匯出地磅資料到新工作表()
Dim vSht As Worksheet, R&, vR As Range, SHN$, xSht As Worksheet
'↑宣告(vSht,xSht) 是工作表,(R)是長整數,(vR)是儲存格,(SHN)是字串
Set vSht = ActiveSheet
'↑令vSht是現用工作表
SHN = vSht.Name & "匯出"
'↑令SHN字串變數是vSht工作表名字連接 "匯出"的字串
On Error Resume Next
'↑指定當發生執行階段錯誤時，control 會移至緊接在發生錯誤且繼續執行的語句後面的語句。
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/on-error-statement
Set xSht = Sheets(SHN)
'↑令xSht是名為 SHN變數字串的工作表
On Error GoTo 0
'↑停用目前過程中已啟用的任何錯誤處理常式。
If xSht Is Nothing Then
'↑如果xSht變數判定是Nothing(沒有物件)
Set xSht = Sheets.Add(after:=Sheets(Sheets.Count))
'↑令xSht是在最後一個工作表後面新增一個的工作表
'Sheets(Sheets.Count):最後一個工作
End If
With xSht
'↑以下是關於xSht變數工作表的程序
   .Name = SHN
   '↑重命名是 SHN
   .Cells.Clear
   '↑清除全部儲存格
   .[BK3] = vSht.[BK3].Value
   '↑令[BK3]值是現用工作表[BK3]值
   .[AV1] = vSht.[AV1].Value
   '↑令[AV1]值是現用工作表[AV1]值
   .[BI3] = vSht.[BI3].Value
   '↑令[BI3]值是現用工作表[BI3]值
   R = Val(vSht.[AT51]) * 52
   '↑令R 是現用工作表[AT51]值轉化為數值
   'Val():傳回字串中包含的數位，做為適當類型的數值。
   If R = 0 Then Exit Sub '取得頁數
   '↑如果R這數字變數是 0,就結束程式執行
   vSht.Range("A1:AM" & R).Copy .[A1] '貼上資料
   '↑現用工作表.[A1]到AM欄R列儲存格之間範圍儲存格複製到 xSht變數工作表[A1]
   .Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '序號公式
   '↑xSht變數工作表[A16]到A欄R列儲存格之間範圍儲存格字串是序號公式
   '公式意義:判定指定儲存格範圍是數字的格數轉化為3碼文字,前面再以單引號連接
   'TEXT 函數，以格式代碼來套用格式，藉此變更數字顯示的方式。
   'https://support.microsoft.com/zh-tw/office/text-%E5%87%BD%E6%95%B8-20d5ac4d-7b94-49fd-bb38-93d29371225c
   'COUNT() 函數只會統計數字型的數據資料，若是碰到文字內容的表格也會被忽略。
   '因為儲存格如果是公式!會自動累加其列位.欄位或都累加,視欄列是否冠上"$"符號而定
   .Range("A1:AM" & R) = .Range("A1:AM" & R).Value '全部內容貼成值
   '↑令xSht變數工作表.[A1]到AM欄R列儲存格之間範圍儲存格全部內容貼成值
   For Each vR In vSht.[A1:AM1]
   '↑設順迴圈!令vR儲存格變數是現用工作表裡[A1:AM1]的一格
      .Range(vR.Address).ColumnWidth = vR.ColumnWidth '欄寬
      '↑令xSht變數工作表裡 (vR儲存格變數所在位址)的儲存格欄寬是同vR儲存格變數欄寬
   Next
   .[BK3] = "": .[AV1] = "": .[BI3] = ""
   '↑令xSht變數工作表裡[BK3],[AV1],[BI3]儲存格是空格
End With

On Error Resume Next
'↑遇錯繼續執行不偵錯
With xSht.Range("AK16:AK" & R)
'↑以下是關於xSht變數工作表 [AK16]到AK欄R列儲存格之間範圍儲存格的程序
   .SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '刪除〔文字〕格整列
   '↑判定xlErrors(單元錯誤值) Or xlLogical(具有邏輯值的單元格) Or xlTextValues(具有文字的儲存格)
   '範圍裡這幾種值的儲存格所在的列刪除
   'https://learn.microsoft.com/zh-tw/office/vba/api/excel.xlspecialcellsvalue
   .SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '刪除〔空白格〕整列
   '範圍裡空格儲存格所在的列刪除,(不包含有公式結果為空白字元的儲存格)
End With
On Error GoTo 0
'↑停用目前過程中已啟用的任何錯誤處理常式。
xSht.Select
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

23^#

發表於 2022-12-12 16:44 | 只看該作者

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列&字典
結果:

Option Explicit
Sub TEST()
Dim Brr, Crr, C&, i&, j&, xR, R&, T, V, Y, Z
Dim N&, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
Brr = Range(Sh.[A1], Sh.Cells(Sh.UsedRange.Rows.Count, "AM"))
For i = 1 To [AM1].Column
Y(i & "C") = Columns(i).ColumnWidth
Next
For i = 1 To 15
Y(i & "R") = Rows(i).Rows.RowHeight
Next
For i = 16 To UBound(Brr)
If IsNumeric(Brr(i, [AK1].Column)) And Brr(i, [AK1].Column) <> "" Then
   N = N + 1
   For j = 1 To [AM1].Column
      Brr(N, j) = Brr(i, j)
   Next
End If
Next
Set Y("表頭") = Range(Sh.[A1], Sh.[AM16])
Workbooks.Add
Y("表頭").Copy [A1]
For i = 1 To [AM1].Column
Columns(i).ColumnWidth = Y(i & "C")
Next
For i = 1 To 15
Rows(i).Rows.RowHeight = Y(i & "R")
Next
Range([A16], [AM16]).ClearContents
Range([A16], [AM16]).Borders.LineStyle = 1
[16:16].Copy Rows("17:" & N + 15)
[A16].Resize(N, [AM1].Column) = Brr
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

24^#

發表於 2022-12-13 15:50 | 只看該作者

回復 23# Andy2483

複習&再檢查修改程式碼註解如下:

Option Explicit
Sub TEST()
Dim Brr, Y, C&, i&, j&, R&, N&, Sh As Worksheet
'↑宣告變數:(Brr, Y)是通用型,(C,i,j,R,N)是長整數,(Sh)是工作表
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y 是字典
Set Sh = ActiveSheet: N = 15
'↑令Sh 是現用工作表: 令N=15
Brr = Range(Sh.[A1], Sh.Cells(Sh.UsedRange.Rows.Count, "AM"))
'↑令Brr是二維陣列!倒入[A1]到(AM欄/最後有使用的儲存格那一列的列號儲存格) 值
For i = 1 To 39
'↑設順迴圈!i從 1到39
Y(i & "C") = Columns(i).ColumnWidth
'↑令迴圈數連接"C"當key,item是迴圈數欄位的欄寬
Y(i & "R") = Rows(i).Rows.RowHeight
'↑令迴圈數連接"R"當key,item是迴圈數列位的列高
Next
For i = 16 To UBound(Brr)
'↑設外順迴圈!i從 16到Brr陣列縱向最大列號數
If IsNumeric(Brr(i, 37)) And Brr(i, 37) <> "" Then
'↑如果IsNumeric()函數判斷迴圈列第37欄Brr陣列值是數字,且不是空字元
   N = N + 1
   '↑N數字變數累加 1
   For j = 1 To 39
   '↑設內順迴圈!j從 1到39
      Brr(N, j) = Brr(i, j)
      '↑令N變數列第j迴圈欄的Brr陣列值是 i變數列第j迴圈欄的Brr陣列值
   Next
End If
Next
Set Y("表頭") = Range(Sh.[A1], Sh.[AM16])
'↑令以 "表頭"字串為key,item是現用工作表[A1]到[AM16]儲存格集,倒入Y字典裡
'在開一個新活頁簿之前把用得到的資料用字典與陣列裝起來
'Y("表頭")儲存格裡有公式!
Workbooks.Add
'↑開一個新活頁簿
Y("表頭").Copy [A1]
'↑令以 "表頭"字串查Y字典,把儲存格集複製到此新活頁簿[A1]
For i = 1 To 39
'↑設順迴圈!i從 1到39
Columns(i).ColumnWidth = Y(i & "C")
'↑以i迴圈數連接"C"的字串查Y字典的item值為i迴圈數欄欄寬
Rows(i).Rows.RowHeight = Y(i & "R")
'↑以i迴圈數連接"R"的字串查Y字典的item值為i迴圈數列列高
Next
Range([A16], [AM16]).ClearContents
'↑[A16]到[AM16]儲存格內容清空
Range([A16], [AM16]).Borders.LineStyle = 1
'↑[A16]到[AM16]儲存格格線是細實線
[16:16].Copy Rows("17:" & N)
'↑第16列複製到 17至 N變數列
[A1].Resize(N, 39) = Brr
'↑令[A1]擴展向下N變數列,向右擴展39欄範圍的儲存格,以Brr陣列值倒入
'Y("表頭")儲存格裡有公式!所以需要以陣列值帶入
Set Brr = Nothing
Set Y = Nothing
'↑釋放變數
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

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

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

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