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

Question

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

hana-hana3 · Accepted Answer

＞私が思いつくのは、選択したセルの一つ一つのセルから値を取得して別シートに書き出して

ＶＢＡでは、変数が使えますから、足しこんだ結果を変数に記憶させて置くことができます。
セルの値の取得も変数を使って配列に入れる事が可能です。

今回は、足し算をワークシート関数[=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

anmochi · Answer

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 ' 先ほど計算しておいた合計値を代入

例によってエラーチェックは全然していないので気をつけてね。

Wendy02 · Answer

＞配列などを使って一気に出来る方法などありますで
＞しょうか？
＞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

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

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

＞配列などを使って一気に出来る方法などありますで

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング