結合セルが連続して複数存在する場合。

質問

結合セルが連続して複数存在する場合。
vbaでどのようにしたら単体の結合セルが抽出できるでしょうか？

環境はexcel2003です。（写真は2010ですが)
よろしくお願い致します。

以下ソース

Dim MergeArray(1000),Mergecount '配列 複数のセルを格納したい。,添え字

Dim i,j'while文で使用する。

Dim m, n '行,列

m = 1'行だけ動かす。
n = 2'列は固定する。

i = 1
j = 1

mergecount = 1

while i <= 1000

If Range(Cells(m,n),Cells(m + j,n).mergecells = True then
while j <= 1000
If Range(Cells(m,n),Cells(m + j,n)).mergecells = false then

MergeArray(mergecount)=Range(Cells(m,n),Cells(m + j,n))'->ここでエラーがでました。
MsgBox MergeArray(mergecount)

mergecount = mergecount + 1
m = m + j

End If
j = j + 1
wend
End If

m = m + 1
i = i + 1

Wend

回答No.2

fujillin · ベストアンサー

＞でどのようにしたら単体の結合セルが抽出できるでしょうか
「単体の結合セル」の意味するところがよくわからないけれど、結合セルのRangeごとに控えておきたいということでしょうか？

◆とりあえず、それぞれの結合セルの左上のアドレスを配列に保管する例
全セルに対して走査しているので、ちょっと効率が悪いかも…
（サイズも保管するのなら、MergeAreaの.Rows.Count、.Columns.Countで取得可能です。
　でも、結合状態が変化することがないのならサイズは不要でしょう。）

対象はActiveSheetのUsedRangeになっていますが適宜修正してください。

Sub sample()
　Dim MergeArray() As String
　Dim c As Range, rng As Range, n As Integer

　n = 0
　For Each c In ActiveSheet.UsedRange
　　If (c.MergeCells And c.Address = c.MergeArea.Item(1).Address) Then
　　　n = n + 1
　　　ReDim Preserve MergeArray(1 To n)
　　　MergeArray(n) = c.Address
　　End If
　Next c
End Sub

お礼

すいません。返信が遅くなりました。
色々試したのですが、うまく行きませんでした。

ちなみに、これ自体に取り組む必要がなくなったので
機会があるときにまたやってみます。

ありがとうございました。

回答No.1

himajin100000

Option Explicit

Sub Main()
MsgBox (Cells(1, 1).MergeArea.Rows.Count)
End Sub

'みたいな感じで、連結行数数えられない？

'http://cid-b89cb784f5346675.office.live.com/browse.aspx/TestCase/Q6226119?uc=1

お礼

すいません。返信が遅くなりました。
色々試したのですが、うまく行きませんでした。

ちなみに、これ自体に取り組む必要がなくなったので
機会があるときにまたやってみます。

ありがとうございました。