Excel VBA如何 快速取消合併儲存格_空格填入原合併值
- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
Excel VBA如何 快速取消合併儲存格_空格填入原合併值
請教各位前輩
取消合併儲存格後的空格要填入原來合併格的值
1.有選取動作會比較慢
2.要怎樣才能逐格處理時就取得該合併儲存格的位址?
3.什麼辦法可以縮短執行時間
Option Explicit
Sub 取消合併儲存格_空格填入原合併值()
Dim seL As Range, rnG As Range, T, ad$
T = Timer
Set seL = Cells
For Each rnG In seL.SpecialCells(2)
If rnG.MergeCells = True Then
rnG.Select '有這個動作會比較慢
ad = Selection.Address
rnG.MergeCells = False
Range(ad) = Range(ad).Item(1)
End If
Next
seL.MergeCells = False'補取消 原合併格就無值的除存格
MsgBox "共耗時:" & Timer - T & " 秒"
End Sub |
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
2#
發表於 2020-8-18 12:15
| 只看該作者
回復 1# Andy2483
試試看
Sub 取消合併儲存格_空格填入原合併值_New()
Dim rnG As Range, T, ad$
T = Timer
For Each rnG In Cells.SpecialCells(2)
If rnG.MergeCells = True Then
ad = rnG.MergeArea.Address
With Range(ad)
.MergeCells = False
.Value = .Item(1)
End With
End If
Next
Cells.MergeCells = False '補取消 原合併格就無值的除存格
MsgBox "共耗時:" & Round(Timer - T, 3) & " 秒"
End Sub |
|
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助
|
|
|
|
|
- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
3#
發表於 2020-8-23 15:03
| 只看該作者
回復 2# n7822123
謝謝前輩指導
1.測試結果可節省很多時間
2.學習到的重點:Area的概念
對前輩很抱歉! 這週忙一個剛接到的專案,沒能及時測試回應
謝謝您 |
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
- 帖子
- 2842
- 主題
- 10
- 精華
- 0
- 積分
- 2898
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-4-28
|
4#
發表於 2020-8-23 16:22
| 只看該作者
Dim xR As Range
For Each xR In Cells.SpecialCells(2)
With xR.MergeArea
If .Count > 1 Then .UnMerge: .Value = xR.Value
End With
Next |
|
|
|
|
|
|
- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
5#
發表於 2020-8-24 09:21
| 只看該作者
回復 4# 准提部林
謝謝前輩指導
習得心得如下
1.有些屬性是加了Un就是相反,有些是=True / False,有些屬性兩種都有
2.單一儲存格也視為MergeArea,只是 Count=1
3.巧妙的讓所有格提入了 .Value = xR.Value
4.最近習得方法 練習如下 請前輩再指導
Sub 有註解的合併格_取消合併與複製()
Dim uR As Range, com As Comment
For Each com In ActiveSheet.Comments
Set uR = com.Parent.MergeArea
With uR
If .Count > 1 Then
.UnMerge
uR.Item(1).Copy uR
End If
End With
Next
End Sub |
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|