結合セル内の値を、結合解除後に結合されていた全てのセルへコピーする方法

結合セル内の値を、結合解除後に結合されていた全てのセルへコピーする方法

例えば、A1～A5、A6～A10がそれぞれ結合されており、【あ】【い】という文字が
それぞれ入力されているとします。
各結合セルを解除後、各結合セルを構成していたセルにそれぞれの文字をコピーして、
A1～A5には【あ】
A6～A10には【い】という文字が入るようにしたいと思っているのですが、
実践している下記の方法だと、セル数が多いせいか時間がかかってしまいます。

(1)結合セルを全て解除
(2)For Next if文で1行目から順にセルを見て、何も入力されていなければ、
　直上のセルに入っている文字をコピーする。

そこで、下記のような方法で高速化できないか考えたのですが、記述がわかりません。
ご教授頂けますでしょうか。
または、他に高速化できる方法がありましたらお教え頂けますと幸いです。

(1)上から順に結合セルを探す。
(2)結合セルに当たったら、結合セルを構成する先頭セルと末尾セルのアドレスを変数に記憶
(3)該当の結合セルを解除
(4)記憶したら先頭セルの内容を、先頭セル直下～末尾セルまでにコピー
(5)末尾セルの直下から、(1)～(4)を繰り返す。

どうぞ、よろしくお願いいたします。

No.4 ベストアンサー 回答者： jcctaira 回答日時： 2010/06/04 21:10

使用範囲が少なければ、時間はそれほどかからないと思います…

Sub 結合解除()
　Dim 範囲 As Range
　Dim 結合範囲 As Range
　Dim 値 As Variant
　For Each 範囲 In ActiveSheet.UsedRange
　　　If 範囲.MergeCells Then
　　　　　Set 結合範囲 = 範囲.MergeArea
　　　　　値 = 範囲
　　　　　範囲.UnMerge
　　　　　結合範囲 = 値
　　　End If
　Next
End Sub

この回答へのお礼

お返事が遅くなり申し訳ありません。
頂いたものをそれぞれ試してみて、一番シンプルかつ処理速度が早かった、
こちらのコードを使わせて頂きました！

お礼日時：2010/06/11 17:26

No.3 回答者： keithin 回答日時： 2010/06/04 20:39

たとえば

sub macro1()
　dim LastRow
　
　’一番下にあるのが結合セルかそうでないかで，末尾セルの取り方を工夫
　with range("A65536").end(xlup)
　　if .mergecells then
　　　lastrow = .offset(1).row - 1
　　else
　　　lastrow = .row
　　end if
　end with

　'セルを一個ずつなめるよりは，少し早くできると思います
　range("A:A").unmerge
　with range("A2:A" & lastrow)
　　.specialcells(xlcelltypeblanks).formular1c1 = "=R[-1]C"
　　.value = .value
　end with
end sub

No.2 回答者： oosakin 回答日時： 2010/06/04 20:34

的外れだとごめんなさい、a1～e1結合セルを解除します,(セルは選択状態）そのままメニューから編集・ファイル・右方向にコピーでどうでしょうか。

No.1 回答者： Cupper 回答日時： 2010/06/04 19:43

手動で行う手順を書いてみますので、ご自身でも考えてみてください、

１．A1セルを選択する
２．結合を解除する
３．結合されていたセルが選択されたまま、Ctrlキーと Dキーを同時に押す
４．Shiftキーを押しながら Enterキーを押す
５．下向き矢印を押す
６．２へ戻る