帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2020-10-13 20:53 | 只看該作者

[發問] 如何將三個表格合併在一個表格裡?(巨集執行出錯)

各位大大您好，

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

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

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

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

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

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

附上附檔：

檔案1.zip (17.41 KB)

再麻煩大家協助，感謝。

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

6^#

發表於 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
'幾乎都參數化了!學習到很多知識!謝謝

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

TOP

gaishutsusuru

中學生 Rank: 2

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

5^#

發表於 2020-10-20 21:56 | 只看該作者

回復 4# 准提部林

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

4^#

發表於 2020-10-17 09:32 | 只看該作者

如果工作表數量不確定, 稍修如下:

檔案1-1.rar (16.48 KB)

TOP

gaishutsusuru

中學生 Rank: 2

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

3^#

發表於 2020-10-14 20:07 | 只看該作者

回復 2# jcchiang

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

TOP

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

2^#

發表於 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

TOP