結合されたセルの一覧出力 VBA

質問

お世話になります。

結合されたファイルの一覧を出力したいと思っています。
（できれば、変数に出力したいです）

表があり、ばらばらな範囲で結合されています。

結合した部分には、日付が入っています。

日付が入っている列は、B列とH列で、
その中で「AA」「BB」と入力されている結合セル以外の
結合セル範囲？行？を取得したいと思っております。

B列とH列の結合セル行が同じではありません。

B列は、B5:B13、B18:B25、B30:37　（それ以外のセルは結合してあっても、「AA,BB]と書いてある
H列は、H6:H13,H18:H25、H30::H35,H36:H40（上と同じ）

ということになっております。
できれば、
１．セル結合範囲を検索（行数取得？）
２．セルの内容が日付かどうか確認
３．日付なら、セル行数を取得
ということがしたいです。

日付の形式は、3/1などのように入っています。

このフォームが結構変わるため、
結合しているセルの中身が日付かどうかを確認し、
日付なら行数取得→色んなプログラムでその行数を使用

したいと思っています。

分かりにくい部分が多いかと思いますが、
回答お願い致します。

回答No.4

keithin · ベストアンサー

通常，結合したセル（しかも不定数）がばらばら混じってるとコピーとかできない（するとコピー元がずれる）ので，生データで日付を所定の（結合された/されてない）セルに記入してるという前提で回答してました。
回答の前提をイチイチ説明してなかったのは申し訳なかったですね。

生データの日付に加えて＋１の数式をチマチマ手で記入してたという事でしたら，たとえば次のように。

sub macro1r2()
　dim Target as range
　dim h as range
　dim flg as boolean

　on error resume next
　set target = range("B1")
　set target = union(target, range("B:B,H:H").specialcells(xlcelltypeconstants, xlnumbers))
　set target = union(target, range("B:B,H:H").specialcells(xlcelltypeformulas, xlnumbers))

　for each h in target
　　if isdate(h.value) and h.mergecells then

　　　msgbox "変数hに次のアドレスのセルを格納しました" & vblf & h.mergearea.address(false,false)
　　　flg = true
　　end if
　next

　if not flg then
　　msgbox "NOT FOUND"
　end if
end sub

＃「見つからなかったときはそのようにメッセージを出したい」とコダワルご相談が多いので，ご質問には書かれてませんがその旨追加しています。「行数を使う」の具体的な内容がないので，多分無駄な事を回答してるとは思いますが。

お礼

回答ありがとうございました！

完璧です！
色々説明不足で大変申し訳ありませんでした。
教えて頂いたプログラムを利用させて頂きたいと思います！

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

回答No.3

keithin

ん？？？？

＞H6:H13　と表示されて欲しいのです。（変数格納も）

sub macro1r1()
　dim h as range
　dim res as range

　on error resume next
　for each h in range("B:B,H:H").specialcells(xlcelltypeconstants, xlnumbers)
　　if isdate(h.value) and h.mergecells then

　　　msgbox "変数hに次のアドレスのセルを格納しました" & vblf & h.mergearea.address(false,false)
　　end if
　next

　if res is nothing then
　　msgbox "NOT FOUND"
　end if
end sub

＞.Addressで表示されますでしょうか？

と思ったのでしたら，そのとおりやってみては？と思いましたが，やってみて出来なかった何か問題があったのでしょうか？
それとも手を動かすのがめんどーで，こっちに押しつけたのでしょうか。

お礼

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

補足

回答ありがとうございます！
申し訳ありません。実行いました。
補足のところに書いている最中で、「補足する」を押してしまい
途中で送ってしまいまして…

.Addressで試してみたところ、目的のデータが返ってきました。
しかし、つい先ほど気づいたのですが、
結合セルが一つしか見つからない状態です。

たぶん、他のセルには関数が入っているため
上手く認識してもらえないのかと思います。
関数は、その日付+1　などになっています。

回答No.2

WindFaller

こんにちは。

本来、こういう質問内容の解答は、経験値だけです。ご質問者さんは、VBAを実践で書いているでしょうから、遅かれ早かれ、分かるような気がしますが……。私自身は、こうしたマクロを書いたのは、5年ぶりぐらいなので、変なところがあったら、ご容赦ください。

'//
Sub FindMeargeCells()
　Dim Rng As Range
　Dim c As Range
　Dim a As String
　Dim b As String
　Dim Ar() As Variant
　Dim i As Long
　Dim msg As String
　ReDim Ar(2, 0)
　Ar(0, 0) = "範囲": Ar(1, 0) = "日付": Ar(2, 0) = "行数"
　i = 1
　Set Rng = Intersect(ActiveSheet.UsedRange, Columns("H"))
　Set Rng = Union(Intersect(ActiveSheet.UsedRange, Columns("B")), Rng)
　b = Rng.Address
　For Each c In Rng
　　If c.MergeCells Then
　　　a = c.MergeArea.Address(0, 0)
　　　If a <> b Then
　　　　ReDim Preserve Ar(2, i)
　　　　Ar(0, i) = a 'セルの結合範囲
　　　　Ar(1, i) = IsDate(c) '日付か
　　　　If IsDate(c) Then
　　　　　Ar(2, i) = Range(a).Rows.Count '日付なら行数
　　　　Else
　　　　　Ar(2, i) = " - "
　　　　End If
　　　　i = i + 1
　　　　b = a
　　　End If
　　End If
　Next c
　'ワークシートに出力
　'Worksheets("Sheet2").Range("A1").Resize(3, UBound(Ar(), 2) + 1).Value = Ar()
　'MsgBox に出力
　For i = 0 To UBound(Ar, 2)
　　msg = msg & vbCrLf & Ar(0, i) & vbTab & Ar(1, i) & vbTab & Ar(2, i)
　Next i
　MsgBox msg
End Sub

お礼

回答ありがとうございます！
おぉお、なんだかすごいプログラムですね！
解読までに時間がかかりそうな予感…
頑張って1文ずつ読んでいきたいと思います。
ありがとうございました！

回答No.1

keithin

sub macro1()
　dim h as range
　dim res as range

　on error resume next
　for each h in range("B:B,H:H").specialcells(xlcelltypeconstants, xlnumbers)
　　if isdate(h.value) and h.mergecells then
　’msgbox h.mergearea.rows.count '★
　　　if res is nothing then
　　　　set res = h.mergearea
　　　else
　　　　set res = union(res, h.mergearea)
　　　end if
　　end if
　next

　if res is nothing then
　　msgbox "NOT FOUND"
　else
　　res.select
　end if
end sub

ご相談でヤリタイことがイマイチあいまいですが、「日付が入ってて結合されているセルがあったらその行数を利用したい」だけなら、★の一文だけでおしまいです。
「変数に確保したい」とかが入ってるので、余計なマクロで長くなってます。

お礼

回答ありがとうございます！
.addressで思ったとおりの結果が出ました！
しかし、他の日付セルでは上手く行きませんでした。

なんでも、B5:B13、B18:B25、B30:37　と結合してある場合、B5:B13＝日付
　　B18:B25＝B5:B13+1
　　B30:37＝B18:B25+1　のような書き方をしています。
そのせいか、上手く行きません…

補足

回答ありがとうございます！
そうです、大体こんな感じなのです！

ですが、できれば…
H6:H13　を結合していて日付が入っていた場合に、
H6:H13　と表示されて欲しいのです。（変数格納も）

.Addressで表示されますでしょうか？