返回列表 上一主題 發帖

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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
1# 跳轉到 »
發表於 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

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
2#
發表於 2022-11-29 16:40 | 顯示全部帖子
回復 13# samwang


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

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
3#
發表於 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.謝謝論壇!謝謝前輩們的指導!謝謝

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
4#
發表於 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)
所以應該是儲存格集裡的位置!
可是這樣說也還不準,這帖的情境是要合併儲存格,所以儲存格集一定是連續的相連儲存格,
不知道跳格的儲存格集可不可以這樣用?? 待後學後續研究到結果再來此主題回復

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
5#
發表於 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

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
6#
發表於 2022-12-1 14:33 | 顯示全部帖子
本帖最後由 Andy2483 於 2022-12-1 14:37 編輯

回復 20# 星空乂羽翼


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

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
7#
發表於 2022-12-19 08:50 | 顯示全部帖子
本帖最後由 Andy2483 於 2022-12-19 08:52 編輯

回復 24# 准提部林


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


結果:


工作表模組:
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
'↑螢幕畫面在執行結束後自動顯示最後結果
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
返回列表 上一主題