麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] excel 自動合併儲存格 [打印本頁]

作者: 星空乂羽翼 時間: 2022-11-28 15:58 標題: excel 自動合併儲存格

請問各位大前輩
小弟我有製作一個專案進度表
想詢問各位如何讓excel自動判斷年/月份來一序合併儲存格呢?
如下圖
[attach]35533[/attach]

[attach]35532[/attach]

作者: samwang 時間: 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

作者: samwang 時間: 2022-11-29 09:19

回復 2# samwang

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

作者: 星空乂羽翼 時間: 2022-11-29 10:23

回復 2# samwang

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

作者: 星空乂羽翼 時間: 2022-11-29 10:24

回復 3# samwang

好的，謝謝S大！
:D

作者: samwang 時間: 2022-11-29 12:09

回復 4# 星空乂羽翼

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

作者: 星空乂羽翼 時間: 2022-11-29 13:52

回復 6# samwang

S大
目前測試下來，因專案啟始的日期會改變
測試後有一問題
月份合併會出現跨月的情況 (如附圖)
[attach]35540[/attach]
[attach]35541[/attach]
請問如何改善呢？

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

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

作者: Andy2483 時間: 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

作者: samwang 時間: 2022-11-29 13:59

回復 samwang

S大
目前測試下來，因專案啟始的日期會改變
測試後有一問題
月份合併會出現跨月的情況 ...
星空乂羽翼發表於 2022-11-29 13:52

請提供有問題檔案，這樣比較容易測試，謝謝

若想依條件自動合併儲存格，單純的函數是否無法達成？這後學不知道，可以再看看其他大大

作者: 星空乂羽翼 時間: 2022-11-29 14:55

回復 9# samwang

S大
以下為有問題的檔案
[attach]35542[/attach]

另外
日期的產生是
除了起始日期(第一天)是手動填入以外
其餘是用+1的方式來判斷後續日期。
再麻煩S大除錯了，感謝。

作者: 星空乂羽翼 時間: 2022-11-29 14:58

回復 8# Andy2483

感謝Andy2483前輩大大的解說
讓對VBA這塊還是小白的我可以更好的理解
非常感謝！

作者: samwang 時間: 2022-11-29 15:40

回復 samwang

S大
以下為有問題的檔案
另外
日期的產生是
除了起始日期(第一天)是手動填入 ...
星空乂羽翼發表於 2022-11-29 14:55

新增如下紅字部分，請再測試看看，謝謝

Sub test()
Dim Arr, xD, C%, T%, T1%
Application.DisplayAlerts = False
Set xD = CreateObject("Scripting.Dictionary")
C = Cells(5, Columns.Count).End(xlToLeft).Column
Range([e4], Cells(4, C)).UnMerge '解除第四列合併儲存格
Range([e4], Cells(4, C)).Clear '清除資料
Arr = Range([e5], Cells(5, C))
For j = 1 To UBound(Arr, 2)
T = Month(Arr(1, j))
...
...
...

作者: samwang 時間: 2022-11-29 16:24

回復 8# Andy2483

這個V= split用的真好，另外，請教一下xD(x)(1)，為什麼(1)? 這是什麼意思? 謝謝

V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
'↑令V是字串用 ","符號分割的一維陣列
For Each x In xD.Keys
xD(x).UnMerge
xD(x).Merge
xD(x).HorizontalAlignment = xlCenter
mm = Split(x, "/")(1)
xD(x)(1) = V(mm) & "月"
'↑xD字典裡迴圈Key對應的儲存格集第一格填入文字:
'文字是用mm數字抓取 V一維陣列裡對應的國字數字串,後面再加 "月"字
Next

作者: Andy2483 時間: 2022-11-29 16:40

回復 13# samwang

謝謝前輩回復
5:00後家裡忙!明天再繼續討論!
謝謝

作者: Andy2483 時間: 2022-11-30 07:50

回復 13# samwang

前輩早安
1.V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")是抄來的!學准提部林前輩的範例稍做變通
http://forum.twbts.com/viewthrea ... eD2&ordertype=1
For j = 1 To 9 'i = 2 設迴圈將資料帶入Crr陣列第一列
      Crr(xD(T1), j) = Arr(i, Array(9, 10, 11, 12, 22, 23, 24, 8, 5)(j - 1))
      '↑當i = 2:一開始 Crr(xD(T1), j) = Crr(1, j) 因為 xD(T1)=1
      '  ,Array()指定放入的欄位,(j - 1)是因為Array的第一筆索引是0
      '↑當i >= 3:專特案號都是A2009001,所以在前方xD(T1)都有加1  xD(T1) = xD(T1) + 1
      '↑直到i = 50:專特案號變成A2104001,xD(T1)變成1
      '↑到i = 59:專特案號又變成A2009001,所以xD("A2009001") ITEM在前方已繼續加1
Next j

2.xD(x)(1)，為什麼(1)? 這是什麼意思?  後學也不知道!亂猜的!矇到的
因為學習陣列與字典的熱情使然,能用陣列和字典的機會都不想放過,
陣列和字典遇到問題的方式就是:
1.把學習過註解過的帖子拿來運用
2.數字化的亂試!試成功了就更有動力
3.若不成功!查網路相關知識,繼續亂試
4.再不成功!就在論壇開新主題發問
5.平常就把前輩們的心血創作帖一字一行一陣列一字典一迴圈一帖的註解
5.1.確定自己的思考.邏輯是否正確!放上論壇請前輩們再指導,以後複習也方便
5.2.以前走馬看花!認為懂的都是矇懂!認為不懂的就帶過是後學不積極的學法
5.3.現在常不看題意!不想知道網友問什麼!直接開始註解准提部林前輩程式碼!最後才知道題意
5.4.文字敘述的邏輯.口條也想繼續學習
6.三人行必有我師!最重要的是有伴!謝謝前輩
7.謝謝論壇!謝謝前輩們的指導!謝謝

作者: Andy2483 時間: 2022-11-30 11:02

回復 13# samwang

經測試結果:
'xD(x)(1) = xD(x).Offset(0, 0)(1, 1)
'xD(x)(1) = xD(x).Offset(0, 0)(1)
'xD(x)(1) = xD(x).Offset(0, 0)

'xD(x)(1) = xD(x).Item(1, 1)(1, 1)
'xD(x)(1) = xD(x).Item(1, 1)(1)
'xD(x)(1) = xD(x).Item(1, 1)

'xD(x)(1) = xD(x).Cells(1, 1)(1, 1)(1, 1)
'xD(x)(1) = xD(x).Cells(1, 1)(1, 1)
'xD(x)(1) = xD(x).Cells(1, 1)(1)
'xD(x)(1) = xD(x).Cells(1, 1)

'xD(x)(1) = xD(x)(1, 1)
所以應該是儲存格集裡的位置!
可是這樣說也還不準,這帖的情境是要合併儲存格,所以儲存格集一定是連續的相連儲存格,
不知道跳格的儲存格集可不可以這樣用?? 待後學後續研究到結果再來此主題回復

作者: samwang 時間: 2022-11-30 12:02

回復 15# Andy2483

感謝您的解說，另外這個Split讓後學想到也可以改成Array，謝謝
V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
V = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二")

作者: Andy2483 時間: 2022-11-30 13:36

回復 13# samwang

謝謝前輩一起研討 xD(x)(1)
經後學研究結果跟16樓差異很大! 請前輩複製下列程式碼測試就會知道了!
後學不知道該怎麼敘述他的邏輯

Option Explicit
Sub Union_test_1()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union(xU, [C1].Resize(2, 1))
Set xU = Union(xU, [E5].Resize(2, 1))
MsgBox xU(15).Address
End Sub
Sub Union_test_2()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union([C1].Resize(2, 1), xU)
Set xU = Union([E5].Resize(2, 1), xU)
MsgBox xU(15).Address
End Sub
Sub Union_test_3()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union(xU, [B1].Resize(2, 1))
Set xU = Union(xU, [E5].Resize(2, 1))
MsgBox xU(15).Address
End Sub
Sub Union_test_4()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union([B1].Resize(2, 1), xU)
Set xU = Union([E5].Resize(2, 1), xU)
MsgBox xU(15).Address
End Sub
Sub Union_test_5()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union([F5].Resize(2, 1), xU)
Set xU = Union([E5].Resize(2, 1), xU)
MsgBox xU(5).Address
End Sub
Sub Union_test_6()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union(xU, [C1].Resize(2, 1))
Set xU = Union(xU, [E5].Resize(2, 1))
MsgBox xU(15, 1).Address
End Sub
Sub Union_test_7()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union(xU, [C1].Resize(2, 1))
Set xU = Union(xU, [E5].Resize(2, 1))
MsgBox xU(1, 15).Address
End Sub
Sub Union_test_8()
Dim xU As Range
Set xU = [A1:A2]
Set xU = Union(xU, [C1].Resize(2, 1))
Set xU = Union(xU, [E5].Resize(2, 1))
MsgBox xU(15, 15).Address
End Sub

作者: samwang 時間: 2022-11-30 15:27

回復 18# Andy2483

經您的說明已了解，感謝

作者: 星空乂羽翼 時間: 2022-12-1 08:55

回復 12# samwang

感謝S大
已測試完成
功能正常！
非常感謝！

另外想再追ㄧ項功能
請問月份合併後能自動加入外框的格線嗎?

再麻煩了，感謝！

作者: 星空乂羽翼 時間: 2022-12-1 09:00

回復 18# Andy2483

感謝Andy2483前輩的指導
讓小弟我可以有多多學習的機會！
非常感謝！

待後續小弟理解後
若有問題再跟您提出
到時候再麻煩您了！感謝您！

作者: Andy2483 時間: 2022-12-1 14:33

本帖最後由 Andy2483 於 2022-12-1 14:37 編輯

回復 20# 星空乂羽翼

可以參考 : 請問vba的內外框線主題
http://forum.twbts.com/thread-9862-1-1.html
一起學習!

作者: 星空乂羽翼 時間: 2022-12-1 16:55

回復 22# Andy2483

好的
感謝您提供的參考網頁！
讓後學花點時間理解一下，再進行變化。
感謝！

作者: 准提部林 時間: 2022-12-17 11:02

用工作表事件觸發合併月份//
[attach]35616[/attach]

作者: 星空乂羽翼 時間: 2022-12-19 08:37

回復 24# 准提部林

感謝版主准提部林的回覆
不好意思
目前後學積分還差ㄧ些
待我再努力一下
便可下載您的檔案來學習

感謝您！

作者: Andy2483 時間: 2022-12-19 08:50

本帖最後由 Andy2483 於 2022-12-19 08:52 編輯

回復 24# 准提部林

謝謝前輩指導
這帖學到很多知識,後學沒有天才的天分,只能靠勤學習勤練習
學習結果與心得註解如下,請同學可藉此帖再提出不同看法或疑問,
請前輩們再指導
過程:
[attach]35617[/attach]

結果:
[attach]35618[/attach]

工作表模組:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'↑以下是關於觸發(儲存格值編輯)後的程序
   If .Address <> "$E$5" Then Exit Sub
   '↑如果觸發格的位址不是 "$E$5",就結束程式執行
   If IsDate(.Value) Then Call 合併月份
   'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/isdate-function
   'IsDate()如果運算式是日期或是可辨識為有效的日期或時間，會傳回 True，否則會傳回 True 。否則，它會傳回 False。
   'if的條件成立!就執行合併月份副程式
   '觸發[E5]可以帶起連鎖反應,公式更新,月份也更新了
End With
End Sub

Module1:
Sub 合併月份()
Dim xR As Range, xA As Range, m$, m1$, m2$
'↑宣告變數(xR,xA)是儲存格變數,(m,m1,m2)是字串變數
Application.ScreenUpdating = False
'↑螢幕畫面暫不跟著程序變化執行結果
With Range("e4", Cells(5, Columns.Count).End(xlToLeft)(0))
'↑以下是關於儲存格[E4]到第5列最右邊有內容欄位儲存格的程序
   .UnMerge:  .ClearContents
   '↑取消合併儲存格 :清除儲存格內容
   For Each xR In .Cells
   '↑設順迴圈!令xR 是這些儲存格之一,從前面輪到後面(左至右)
      m1 = Format(xR(2), "m")
      '↑令m1是迴圈xR 下方1格儲存格變化為字串(規則是:取日期的不補0月份)
      '同m1 = Format(xR.ITEM(2, 1), "m")
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/format-function-visual-basic-for-applications
      m2 = Format(xR(2, 2), "m")
      '↑令m2是迴圈xR 下方1列左方1欄儲存格變化為字串(規則是:取日期的不補0月份)
      '同m2 = Format(xR.ITEM(2, 2), "m")
      If m1 <> m Then
      '↑如果m1<>m ,m字串變數的初始值是"",這樣的判斷式在第一格時條件就會成立!
      '這是後學要學習的方法!既然都知道要宣告m字串,為什麼又不會讓m跟m1比就會得到結果!!
      '需要跳脫字串變數一定要給一個字串才拿來做邏輯判斷的想法!
      '勤學習勤練習看看可否跳脫,謝謝前輩指導
         m = m1:  Set xA = xR
         '↑if條件成立!就令m=m1 ,令xA儲存格變數是 xR
         xR = Application.Text(xR(2), "[DBNum1]m月")
         '↑令xR儲存格變數值是迴圈xR下方1格儲存格變化為小寫月份字串
         'Text()會傳回指定之物件的格式化文字。唯讀的 String
         '[DBNum1]:中文小寫
         '[DBNum2]:中文大寫
      End If
      If m2 <> m Then Range(xR, xA).Merge
      '↑如果m2 <> m,就讓儲存格(xR尾格, xA頭格)之間的儲存格合併
   Next
.Borders.LineStyle = 1
   '令整個儲存格集範圍格線是細實線
End With
End Sub
'↑螢幕畫面在執行結束後自動顯示最後結果

作者: 星空乂羽翼 時間: 2022-12-19 16:06

回復 26# Andy2483

謝謝前輩自行學習時也將註解放上來
讓後學可以更好理解學習
非常感謝！

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