Skip to content

Instantly share code, notes, and snippets.

@kos59125
Last active September 4, 2015 09:09
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save kos59125/2a4892c08b1d9e8a1097 to your computer and use it in GitHub Desktop.
Save kos59125/2a4892c08b1d9e8a1097 to your computer and use it in GitHub Desktop.
アクティブシートの結合されたセルの結合を解除して,すべてのセルの値を結合元のセルの値で埋めます。
Option Explicit
' アクティブシートの結合されたセルの結合を解除して,すべてのセルの値を結合元のセルの値で埋めます。
Public Sub Unmerge()
Dim OuterCell As Variant
Dim InnerCell As Variant
Dim Value As Variant
Dim MergeArea As Object
Dim Updating As Boolean ' 現在のスクリーン更新状態
Updating = Application.ScreenUpdating
' スクリーン更新停止
Application.ScreenUpdating = False
For Each OuterCell In ActiveSheet.UsedRange
If OuterCell.MergeCells Then
Value = OuterCell.Value
Set MergeArea = OuterCell.MergeArea
OuterCell.MergeCells = False
For Each InnerCell In MergeArea.Cells
InnerCell.Value = Value
Next InnerCell
End If
Next OuterCell
Set MergeArea = Nothing
' スクリーン更新状態を元に戻す
Application.ScreenUpdating = Updating
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment