准提部林

回復 18# simplehope


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

Andy2483

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

Andy2483

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

下載 (298.03 KB)

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

Andy2483

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