選択したセルの値を足した後に結合して入力したい

質問

VBAで初めてプログラミングしています。
初心者の質問で恐縮なのですが、よろしくお願いします。
数字が並んだ表を作成し、その表のいくつかを選択
します。（縦、横で結合可能な選択と前提）
選択したそれらの値を足した結果を、選択したセルを
結合したところに書き出す。
ということをしたいのですが、どうすれば出来ますで
しょうか？
私が思いつくのは、選択したセルの一つ一つのセルか
ら値を取得して別シートに書き出して、それを足し、
セルを結合した後に足した値をコピーする。というこ
とくらいです。
配列などを使って一気に出来る方法などありますで
しょうか？
FormulaArray なるものを使おうとしたのですが、上手
く行かず途方にくれております。
何卒、よろしくお願い致します。

回答No.3

hana-hana3 · ベストアンサー

＞私が思いつくのは、選択したセルの一つ一つのセルから値を取得して別シートに書き出して

ＶＢＡでは、変数が使えますから、足しこんだ結果を変数に記憶させて置くことができます。
セルの値の取得も変数を使って配列に入れる事が可能です。

今回は、足し算をワークシート関数[=SUM()]で計算したので簡単にできました。
また、下記のプログラムは[Ctrl]で個々に選択したセルは連続したセルとして扱われないので、結合対象になりません。
なので、範囲の選択は[Shift]やドラッグで選択した矩形範囲のみ対象です。
また、複数の選択範囲があっても処理できます。

Sub MergeArea()

Dim c As Variant
Dim Adr As Variant
Dim Tp As Variant
Dim sm As Single

Adr = Split(Selection.Address, ",")

Application.DisplayAlerts = False
For Each c In Adr
If InStr(c, ":") > 0 Then
Tp = Split(c, ":")
sm = Application.WorksheetFunction.sum(Range(c))
Range(c).Merge
Range(Tp(0)) = sm
End If
Next

Application.DisplayAlerts = True

End Sub

お礼

ご返信、ありがとうございます！
こちらも知らない関数があるのですが、辞典とにらめっこを
して理解できました！
わかりやすくして頂きましてありがとうございます！
この方法で頑張って行きたいと思います。
ありがとうございました！

回答No.2

Wendy02

＞配列などを使って一気に出来る方法などありますで
＞しょうか？
＞FormulaArray
FormulaArray は、実際にセルを使ってしまいますし、もし使うのでしたら、FormulaArrayではなくて、Evaluate の中で計算したほうが速いですね。これは、Excel独特ですね。しかし、セルをいちいち使っていたのでは面倒だから、一旦、配列に値を入れてしまうわけです。それも、配列にあまり手を掛けると手間が掛かりますので、流し込んでしまいます。

以下は、流れに任せて作ったので、ほとんどチェックもしていません。（^^;
うまくいかなかったらすみません。

Sub CellMargeCalc()
Dim rng As Range
Dim ArrayRng As Variant
Dim v As Long, h As Integer '縦と横の数
Dim i As Long, j As Long
Set rng = Selection 'マウスで選択
ArrayRng = rng.Value '配列に入れる
With rng
　v = .Rows.Count '行数
　h = .Columns.Count '列数
　'
　If v > h Then
　 ReDim Preserve ArrayRng(1 To v, 1 To h + 1)
　 For i = 1 To v
　　For j = 1 To h
　　 ArrayRng(i, h + 1) = ArrayRng(i, h + 1) + ArrayRng(i, j)
　　Next j
　 Next i
　 .ClearContents
　 For i = 1 To v
　　.Rows(i).MergeCells = True
　　.Rows(i).HorizontalAlignment = xlCenter
　　.Cells(i, 1).Value = ArrayRng(i, h + 1)
　 Next i
　ElseIf v < h Then
　 ArrayRng = Application.Transpose(ArrayRng)
　 ReDim Preserve ArrayRng(1 To h, 1 To v + 1)
　 For i = 1 To h
　　For j = 1 To v
　　 ArrayRng(i, v + 1) = ArrayRng(i, v + 1) + ArrayRng(i, j)
　　Next j
　 Next i
　 .ClearContents
　 For i = 1 To h
　　.Columns(i).MergeCells = True
　　.Columns(i).VerticalAlignment = xlCenter
　　.Cells(1, i).Value = ArrayRng(i, v + 1)
　 Next i
　 Else
　 MsgBox "縦横同数のため処理できません", 64
　End If
End With
End Sub

お礼

ご返信、ありがとうございます！
詳細に書いて頂きましてありがとうございます！
しかし、私にはまだ知らない関数などが多々ありまして、、、
これから辞典とにらめっこしながら勉強させて頂き
たいと思います。
本当にありがとうございました！

回答No.1

anmochi

VBA使ってんならぐるぐる回してメモリに溜め込んでおけばどうかな。

Dim r As Range ' 選択セル内をぐるぐる回す変数
Dim l As Long ' 一回メモリに溜め込む合計値 Doubleにしても良いだろう

Range("B4:D5").Select ' 仮にB4からD5を選択してみた（１）
l = 0 ' 合計を利用に先立って0にクリア
For Each r In Selection ' 選択範囲を1セル1セル回す
l = l + r.Value ' 足しこむ
r.Value = "" ' 一応セルをクリアしておく
Next ' 次へ
Selection.Merge ' セルを結合
Selection.Value = l ' 先ほど計算しておいた合計値を代入

例によってエラーチェックは全然していないので気をつけてね。

お礼

早速のご返信、ありがとうございます！
SelectionをForに指定することで１セルずつ回るの
ですか！勉強不足でした・・・。
こんな簡単な方法があったとは、、、もっと精進し
ないとです。
ありがとうございます！