1276505613 エクセルVBAについて、アップした図もご覧ください。

結合セルの並びを移動する場合、ループを使用して下記のようにすれば
セル範囲を、結合セルの塊ごとに移動することができます。

---
Dim moveNum As Integer
moveNum = 3 '移動したい数

Set newRange = Range("A1")
For j = 1 To moveNum
'下の隣の結合セルの範囲にセットする。
'Offset(<2以上>, 0)とは違い、Offset(1, 0)であれば、MergeAreaを使用しなくても目的を果たす
Set newRange = newRange.Offset(1, 0)
Next

MsgBox newRange.Value '「結合セル4」が表示される
---

一方、結合セルではない普通のセル(図では「単体セル」)の場合、

---
Set newRange = Range("B1").Offset(moveNum, 0)
MsgBox newRange.Value '「単体セル4」が表示される
---
で、一発で(コード1行で)範囲をセットすることができます。

そこで質問ですが、結合セルも同じように、ループを使わずに一発で
移動(範囲をセット)することは(VBAのなんらかのプロパティなどを用いて)できないのでしょうか。

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2010/06/14 17:53:35
  • 終了:2010/06/19 12:55:28

回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/06/15 09:29:59

ポイント50pt

条件としては

1 ループを使わない。

2 任意を結合セルを取得する。(moveNumを変更するだけでいい)


この条件を満たす方法になるかと思います。

それは次の方法で可能です。

Sub test()
    Dim moveNum As Integer
    Dim newRange As Range
    moveNum = 3
    Set newRange = Cells(Application.WorksheetFunction.Small(Evaluate("IF(A1:A99<>0,ROW(A1:A99),100)"), moveNum), "A").MergeArea
    newRange.Select
End Sub

何をやっているかというと、evaluateに配列数式を処理させて、配列を作りmoveNum番目に小さい値を取得します。

この値は結合セルの一番上の行になっているので、その値からMergeAreaで結合セルを取得しています。


まあ、これはできるかどうかのパズルみたいなもんで実際やるとしたら、私ならループを回しますね。

id:kyoko55

ありがとうございます。

確かにパズルみたいですね。

簡単にできる方法はないんでしょうね。勉強になりました。

2010/06/19 12:53:42
id:hathi No.2

hathi回答回数208ベストアンサー獲得回数462010/06/15 13:11:00

ポイント50pt

もしかして、こんなことでも良いのでしょうか。

 1 移動量(差分)を指定する方式ではなくて、マージエリアの連番数字で指定する

 2 対象とするマージエリアは1列にのみある (例えば A列)

    マージエリアではない単一のセルもその範囲にあり得る

 3 事前にシートの配置状況をマクロで調べて、配列に収容しても良い


下記のようなコードでも、とりあえず動くようです。


 Dim sh As Worksheet
 Dim er As Variant
 Dim erc                    ' マージエリアをカウントするカウンタを収容する配列
 Set sh = ActiveSheet
 Set er = sh.Cells(1, 1).Resize(96, 1)     '  マージエリアが存在する範囲 仮にA1:A96を全域とします
 ReDim erc(1 To 96)        ' マージエリアの存在する範囲と合わせる
 mc = 0                    ' マージエリアの連番
 ' マージエリアの連番を配列に収容する
 For i = 1 To 96  ' マージエリアが存在する範囲を頭から順番に総当たりする
   If er(i).MergeCells Then  ' 該当セルがマージエリアになっていれば
     mc = mc + 1              ' マージエリアの連番をカウントアップ
     erc(i) = mc              ' カウンタ収容配列にカウンタ数値を入れる
     i = i - 1 + er(i).MergeArea.Count  ' 同じマージエリアのところは飛ばす
   End If
 Next
 
 
 Dim moveNum As Integer
 moveNum = 17  '移動したいマージエリアの連番

     ' 間運他収容配列ercから、moveNumと一致するセル(単一セル=マージセルの先頭)を探して、setする
 Set newRange = er(WorksheetFunction.Match(moveNum, erc), 1)


 MsgBox newRange.Value
 newRange.Select
 newRange.Value = "これかな"
 newRange.Interior.ColorIndex = 3
id:kyoko55

ありがとうございます。

簡単にできる方法はないことがわかりました。

試してみたいと思います。

2010/06/19 12:54:57

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません