返回列表 上一主題 發帖

[發問] 請問如何一次合併儲存格

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
1# 跳轉到 »
發表於 2020-5-9 10:10 | 顯示全部帖子
Sub 合併()
Dim T$, xR As Range, xH As Range
Application.DisplayAlerts = False
For Each xR In Range([A2], [A65536].End(xlUp))
    If xR <> T Then Set xH = xR: T = xR
    If xR(2) <> T Then Range(xH, xR).Merge
Next
End Sub

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
2#
發表於 2020-5-9 13:12 | 顯示全部帖子
回復 3# gaishutsusuru

Sub 合併()
Dim R&, i&, xA As Range, xZ As Range, T$, xH As Range
R = [A65536].End(xlUp).Row
Set xA = Range("A2:A" & R)
Set xZ = Range("Z2:Z" & R) '借用z欄當合併格
xA.Copy: xZ.PasteSpecial xlPasteFormats  '複製格式到z欄
For i = 1 To xA.Count
    If xA(i) <> T Then Set xH = xZ(i): T = xA(i)
    If xA(i + 1) <> T Then Range(xH, xZ(i)).Merge
Next i
xZ.Copy: xA.PasteSpecial xlPasteFormats '複製格式到a欄
xA.Borders.LineStyle = 1 '加框線, 解除合併後仍保有框線
xZ.EntireColumn.Delete '清除z欄
End Sub

Sub 合併解除()
Range("A:A").UnMerge
End Sub

以後任何發帖要自行上範例檔, 免得別人還花時間做:
X0001.rar (7.7 KB)


=========================

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題