[發問] excel 自動合併儲存格

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2022-11-29 08:44 | 只看該作者

回復 1# 星空乂羽翼

請測試看看，謝謝
Sub test()
Dim Arr, xD, C%, T%, T1%
Application.DisplayAlerts = False
Set xD = CreateObject("Scripting.Dictionary")
C = Cells(5, Columns.Count).End(xlToLeft).Column
Arr = Range([e5], Cells(5, C))
For j = 1 To UBound(Arr, 2)
T = Month(Arr(1, j))
T1 = Split(Arr(1, j), "/")(2)
If T1 = 1 Then
      If T = 1 Then
         Cells(4, j + 4) = "一月"
      ElseIf T = 2 Then
         Cells(4, j + 4) = "二月"
      ElseIf T = 3 Then
         Cells(4, j + 4) = "三月"
      ElseIf T = 4 Then
         Cells(4, j + 4) = "四月"
      ElseIf T = 5 Then
         Cells(4, j + 4) = "五月"
      ElseIf T = 6 Then
         Cells(4, j + 4) = "六月"
      ElseIf T = 7 Then
         Cells(4, j + 4) = "七月"
      ElseIf T = 8 Then
         Cells(4, j + 4) = "八月"
      ElseIf T = 9 Then
         Cells(4, j + 4) = "九月"
      ElseIf T = 10 Then
         Cells(4, j + 4) = "十月"
      ElseIf T = 11 Then
         Cells(4, j + 4) = "十一月"
      ElseIf T = 12 Then
         Cells(4, j + 4) = "十二月"
      End If
End If
If xD.Exists(T) Then
      Set xD(T) = Union(xD(T), Cells(4, j + 4))
Else
      Set xD(T) = Cells(4, j + 4)
End If
Next
For Each ky In xD.keys
xD(ky).Merge
Next
Application.DisplayAlerts = True
End Sub

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

3^#

發表於 2022-11-29 09:19 | 只看該作者

回復 2# samwang

更新一下合併後置中如下，謝謝
For Each ky In xD.keys
xD(ky).Merge
xD(ky).HorizontalAlignment = xlCenter '置中
Next

星空乂羽翼

中學生 Rank: 2

帖子: 63
主題: 7
精華: 0
積分: 90
點名: 60
作業系統: windows 7
軟體版本: 2013
閱讀權限: 20
性別: 男
註冊時間: 2022-9-23
最後登錄: 2024-8-10

2023年全勤獎章

4^#

發表於 2022-11-29 10:23 | 只看該作者

回復 2# samwang

感謝前輩s大的回覆
我先花點時間理解及測試
後續有問題再跟前輩回報。

星空乂羽翼

中學生 Rank: 2

帖子: 63
主題: 7
精華: 0
積分: 90
點名: 60
作業系統: windows 7
軟體版本: 2013
閱讀權限: 20
性別: 男
註冊時間: 2022-9-23
最後登錄: 2024-8-10

2023年全勤獎章

5^#

發表於 2022-11-29 10:24 | 只看該作者

回復 3# samwang

好的，謝謝S大！
:D

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

6^#

發表於 2022-11-29 12:09 | 只看該作者

回復 4# 星空乂羽翼

處理過程大致如下:
1. 根據第5列資料，在第4列位置會自動填入月份，如一月、二月...
2. 合併同月份，根據第5列資料

星空乂羽翼

中學生 Rank: 2

帖子: 63
主題: 7
精華: 0
積分: 90
點名: 60
作業系統: windows 7
軟體版本: 2013
閱讀權限: 20
性別: 男
註冊時間: 2022-9-23
最後登錄: 2024-8-10

2023年全勤獎章

7^#

發表於 2022-11-29 13:52 | 只看該作者

回復 6# samwang

S大
目前測試下來，因專案啟始的日期會改變
測試後有一問題
月份合併會出現跨月的情況 (如附圖)

請問如何改善呢？

另外小弟我沒有VBA的基礎
所以目前會自行上網查閱了解S大您的代碼寫法
想另外請ㄧ個問題
1.若想依條件自動合併儲存格，單純的函數是否無法達成？

以上，再麻煩S大指教，謝謝！

Andy2483

　暱稱: 厚臉皮的學生

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

8^#

發表於 2022-11-29 13:57 | 只看該作者

本帖最後由 Andy2483 於 2022-11-29 14:00 編輯

回復 1# 星空乂羽翼

謝謝前輩發表此主題與範例
謝謝 samwang前輩提供解決方法與解說,後學學習後用相同方法,不同的陳述方式練習陣列與字典
心得註解如下,請各位前輩再指導

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, C&, x, V, xD, Sh, Tym$, mm&
'↑宣告變數
Set Sh = Sheets("P-012-02A-預定工作進度表")
'↑令Sh 是工作表(以下稱:進度表),名稱是 "P-012-02A-預定工作進度表"
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD 是字典
C = Sh.UsedRange.EntireColumn.Columns.Count
'↑令C 是有使用儲存格範圍的最大欄位數
Brr = Sh.Range(Sh.Cells(5, 1), Sh.Cells(5, C))
'↑令Brr 是二維陣列!倒入從進度表[A5]到第五列最後一欄儲存格範圍儲存格值
For x = 1 To UBound(Brr, 2)
'↑設順迴圈從1到Brr陣列橫向欄位的最大欄位數
If IsDate(Brr(1, x)) Then
'↑如果迴圈陣列值是日期??
   Tym = Format(Brr(1, x), "yyyy/mm")
   '↑如果If條件成立!令Tym字串變數是迴圈陣列值轉化為四碼年加 "/" 符號加兩碼月的字串
   If xD.Exists(Tym) = Empty Then
   '↑如果用 Tym字串變數查察字典裡是初始值
      Set xD(Tym) = Sh.Cells(4, x)
      '↑令Tym字串變數是 xD字典裡的key,Item是進度表第4列.迴圈欄的儲存格
      Else
      Set xD(Tym) = Union(xD(Tym), Sh.Cells(4, x))
      '↑令Tym字串變數是 xD字典裡的key,
      'Item是原本Item裡的儲存格再加入進度表第4列.迴圈欄的儲存格的儲存格集
   End If
End If
Next
V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
'↑令V是字串用 ","符號分割的一維陣列
For Each x In xD.Keys
'↑設順迴圈!令x是 xD字典Keys的一員
xD(x).UnMerge
'↑xD字典裡迴圈Key對應的儲存格集取消合併儲存格
xD(x).Merge
'↑xD字典裡迴圈Key對應的儲存格集執行合併儲存格
xD(x).HorizontalAlignment = xlCenter
'↑xD字典裡迴圈Key對應的儲存格集文字左右置中
mm = Split(x, "/")(1)
'↑令mm&數字變數是x用 "/"符號拆解的一維陣列!取第 1個字串轉成數字(月份)
'因為此一維陣列元素是字串,因宣告是mm數字!所以字串會變成數字
'ps:此一維陣列的第0個字串是(四碼年分)
xD(x)(1) = V(mm) & "月"
'↑xD字典裡迴圈Key對應的儲存格集第一格填入文字:
'文字是用mm數字抓取 V一維陣列裡對應的國字數字串,後面再加 "月"字
Next
Set Brr = Nothing
Set xD = Nothing
End Sub