標題: [發問] 如何將三個表格合併在一個表格裡?(巨集執行出錯) [打印本頁]

---

作者: gaishutsusuru    時間: 2020-10-13 20:53     標題: 如何將三個表格合併在一個表格裡?(巨集執行出錯)

各位大大您好，

關於這個發問，之前准提大大已有提供解法：連結。

但是因為要在F欄增加運算：E欄的值都乘上5。

所以我有把巨集稍做更改如下，為了不要把F欄刪除掉：

原本：Sheets("總表").UsedRange.Clear
更改成：
Sheets("總表").Select
Columns("A:E").Select
Selection.ClearContents

原本不會出錯。但如果筆數減少後，在執行時，就會出錯，如下2個圖。
[attach]32614[/attach]
[attach]32615[/attach]

因此想請問該如何解決呢? 是否巨集要再做更改呢?

附上附檔：[attach]32616[/attach]

再麻煩大家協助，感謝。

---

作者: jcchiang    時間: 2020-10-14 08:24

回復 1# gaishutsusuru

紅字修正
Sub TEST()
Dim Arr, Brr, xD, i&, j&, R&, C&, U&, T$

Sheets("總表").Select
Columns("A:E").Clear


Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 2000, 1 To 99)
Brr(1, 1) = "號碼"
For i = 1 To Sheets.Count
    If Left(Sheets(i).Name, 1) <> "X" Then GoTo i99
    C = C + 1: Brr(1, C + 1) = Sheets(i).Name
    Arr = Sheets(i).UsedRange
    For j = 2 To UBound(Arr)
        T = Arr(j, 1): If T = "" Then GoTo j99
        U = xD(T)
        If U = 0 Then R = R + 1: U = R: xD(T) = R: Brr(U + 1, 1) = T
        Brr(U + 1, C + 1) = Brr(U + 1, C + 1) + Arr(j, 2)
j99: Next j
i99: Next i
With Sheets("總表").[a1].Resize(R + 1, C + 2)
     .Columns(1).NumberFormatLocal = "@"
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlYes
     .Columns(C + 2) = "=SUM(RC[-" & C & "]:RC[-1])"
     .Rows(R + 2) = "=n(SUM(R[-" & R & "]C:R[-1]C))"
     .Cells(1, C + 2) = "合計": .Cells(R + 2, 1) = "合計"
     Union(.Rows(1), .Rows(R + 2), .Columns(C + 2)).Font.Bold = True
End With
End Sub

---

作者: gaishutsusuru    時間: 2020-10-14 20:07

回復 2# jcchiang

啊~原來問題出在這裡，可以用了，感謝jcchiang大大的協助。:)

---

作者: 准提部林    時間: 2020-10-17 09:32

如果工作表數量不確定, 稍修如下:
[attach]32621[/attach]

---

作者: gaishutsusuru    時間: 2020-10-20 21:56

回復 4# 准提部林



謝謝准提大大的回覆，我來試看看。

---

作者: Andy2483    時間: 2023-3-7 14:11

本帖最後由 Andy2483 於 2023-3-7 14:36 編輯

回復 4# 准提部林


    謝謝前輩

Sub THK()
MsgBox [A1].Address(0, 0)
'↑是去除全部位址中的"$"符號,在公式中是不固定列位也不固定欄位
MsgBox [A1].Address(1, 0)
'↑是去除位址中欄號前的"$"符號,在公式中是固定列位但不固定欄位
MsgBox [A1].Address(0, 1)
'↑是去除位址中列數前的"$"符號,在公式中是不固定列位但固定欄位
MsgBox [A1].Address(1, 1)
'↑在公式中是固定列位也固定欄位,(1, 1)可省略
End Sub


Sub TEST()
Dim Arr, Brr, xD, i&, j&, R&, C&, U&, T$
'↑宣告變數:(Arr,Brr,xD)是通用型變數,(i,j,R,C,U)是長整數變數,T是字串變數
Sheets("總表").UsedRange.Clear
'↑令總表工作表有使用儲存格做 清除
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
ReDim Brr(1 To 2000, 1 To 99)
'↑宣告Brr這通用型變數是 二維陣列!範圍大小:縱向從1 到2000,橫向從1 到99
Brr(1, 1) = "號碼"
'↑令第1列第1欄Brr陣列值是 "號碼" 字串
For i = 1 To Sheets.Count
'↑設順迴圈!i從1 到 工作表數量(如果有被隱藏的,也算)
    If Left(Sheets(i).Name, 1) <> "X" Then GoTo i99
    '↑如果第i迴圈個工作表名字左側那個字元不是 "X"!就跳到 i99位置繼續執行
    C = C + 1: Brr(1, C + 1) = Sheets(i).Name
    '↑令C這長整數變數累加 1
    '再令第1列(C變數+1)欄的Brr陣列值是 第i迴圈個工作表名字
    Arr = Sheets(i).UsedRange
    '↑令Arr這通用型變數是 二維陣列!
    '以i迴圈工作表有使用儲存格擴展最小方正範圍儲存格值帶入
    For j = 2 To UBound(Arr)
    '↑設順迴圈!j從2 到Arr陣列縱向最大索引列號
        T = Arr(j, 1): If T = "" Then GoTo j99
        '↑令T這字串變數是 j迴圈列第1欄Arr陣列值,
        '再如果T變數是空字元就跳到 j99位置繼續執行
        U = xD(T)
        '↑令U這長整數是 以T變數查xD字典回傳的Item值
        If U = 0 Then R = R + 1: U = R: xD(T) = R: Brr(U + 1, 1) = T
        '↑如果U變數是 0!就
        '令R這長整數變數累加1:令U變數裝入R變數:令以T變數當Key,Item是 R變數納入xD字典
        '令(U變數+1)列第1欄Brr陣列值是 T變數
        Brr(U + 1, C + 1) = Brr(U + 1, C + 1) + Arr(j, 2)
        '↑令(U變數+1)列第(C變數+1)欄Brr陣列值是 自身+j迴圈第2欄Arr陣列值
j99: Next j
i99: Next i
With Sheets("總表").[A1].Resize(R + 2, C + 3)
'↑以下是關於總表工作表[A1]擴展向下(R變數+2)列,向右擴展(C變數+ 3)欄的範圍儲存格 程序
     .Cells(2, 1).Resize(R).NumberFormatLocal = "@"
     '↑令With範圍的第2列第1欄儲存格向下擴展R變數列的範圍儲存格格式是 文字
     .Value = Brr
     '↑令With範圍的儲存格值以Brr陣列值帶入
     .Borders.LineStyle = 1
     '↑令With範圍的儲存格框線是 細實線
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlYes
     '↑令With範圍的儲存格以With範圍第1格為基準做1層次有標題列的順排序
     .Columns(C + 2) = "=SUM(" & .Cells(1, 2).Resize(1, C).Address(0, 0) & ")"
     '↑令With範圍的(C變數+2)欄是公式 "=SUM("字串 連接 儲存格位址 再連接 ")"字元
     '儲存格位址:With範圍第1列第2欄儲存格擴展向右C變數欄,此範圍儲存格位址(去除全部$符號)
     .Columns(C + 3) = "=" & .Cells(1, C + 2).Address(0, 0) & "*5"
     '↑令With範圍的(C變數+3)欄是公式 "="字元 連接 儲存格位址 再連接 "*5"字串
     '儲存格位址:第1列第(C變數+2)欄儲存格位址(去除全部$符號)
     .Rows(R + 2) = "=N(SUM(" & .Cells(2, 1).Resize(R).Address(0, 0) & "))"
     '↑令With範圍的(R變數+2)列是公式 "=N(SUM("字串 連接 儲存格位址 再連接 "))"字串
     '儲存格位址:[A2]儲存格擴展向下R變數列,此範圍儲存格位址(去除全部$符號)
     'https://support.microsoft.com/zh-tw/office/n-%E5%87%BD%E6%95%B8-a624cad1-3635-4208-b54a-29733d1278c9
     .Cells(1, C + 2) = "合計": .Cells(1, C + 3) = "金額": .Cells(R + 2, 1) = "合計"
     '↑令With範圍的儲存格第1列(C變數+2)欄儲存格值是 "合計" 字串
     '↑令With範圍的儲存格第1列(C變數+3)欄儲存格值是 "金額" 字串
     '↑令With範圍的儲存格第(R+2)列第1欄儲存格值是 "合計" 字串
     Union(.Rows(1), .Rows(R + 2), .Columns(C + 2), .Columns(C + 3)).Font.Bold = True
     '↑令儲存格集的文字以 粗體顯示
     '儲存格集:With範圍的(第1列,第R變數+2列,C變數+2欄,C變數+3欄)
End With
End Sub
'幾乎都參數化了!學習到很多知識!謝謝

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)