2行2列の行列を所望の回数だけ計算させるVBAコード

質問

画像のような２行２列の行列を所望の回数だけ計算させるVBAマクロはどのように作成すればよろしいのでしょうか？

回答No.8

Wendy02 · ベストアンサー

こんにちは。

お返事をお待ちしていました。

さて、最初に、VBA方式と数式方式では、明らかに数式のほうが良いですが、他に数式がないのか、SUMやPRODUCT 関数など試してみましたが、4つのセルの統一数式では他には見つかりません。

>このコードだと行列が奇数個の時には、最後の行列が計算できません。

　..Rows.Count \ 4
　RwCnt * 4 の「4」は、私の間違いでした。4つのセルなので、4と勘違いしていました。2行ずつなので、2で割り算し2で掛けなくてはいけないのですが、それよりも、割り算掛け算せずに、奇数・偶数で増減したほうがよいようです。

細かい部分を修正してみました。

×　Cells(i + 1, CL + 4).Formula 　-->　.Cells(i + 1, CL + 4).Formula

'-------------------------------------------

Sub MacroSample2a()
　　Dim i As Long
　　Dim j As Long
　　Dim c As Variant
　　Dim RwCnt As Integer
　　Dim flg As Boolean
　　Const RW As Integer = 5 '初期行
　　Const CL As Integer = 11 '対象列

　　With ActiveSheet
　　　　.Range(.Cells(RW, CL + 2), .Cells(Rows.Count, CL + 2).End(xlUp)).Resize(, 3).ClearContents
　　　　RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count
　　　 For i = RW + 2 To RW + RwCnt - (2 - (RwCnt Mod 2)) Step 2
　　　　　For Each c In Cells(i, CL + 2).Resize(2, 2)
　　　　　　 If flg = False Then
　　　　　　　c.FormulaArray = "=SUMPRODUCT(R[-2]C" & CL & ":R[-2]C" & CL + 1 & ",TRANSPOSE(R" & i & "C[-2]:R" & i + 1 & "C[-2]))"
　　　　　　　j = j + 1
　　　　　　　If j > 3 Then flg = True
　　　　　　 Else
　　　　　　　c.FormulaArray = "=SUMPRODUCT(R[-2]C" & CL + 2 & ":R[-2]C" & CL + 3 & ",TRANSPOSE(R" & i & "C[-2]:R" & i + 1 & "C[-2]))"
　　　　　　 End If
　　　　　Next c
　　　　　　.Cells(i + 1, CL + 4).Formula = "=R[-1]C[-2]*RC[-1]-R[-1]C[-1]*RC[-2]"
　　　　Next i
　　End With
End Sub

'-------------------------------------------

補足

お時間割いて頂き本当にありがとうございます。
もう少しお付き合い下さい。

計算自体は出来ているので安心はしているのですが、
結局何をやっているかわからないと応用も利きませんし、進歩もないと思って理解しながら進んでいます。

せっかく細かい部分を修正していただいたのですが、まだ追いついていません。
今、やっとこの行が何をしているのか理解したところです。

＞c.FormulaArray = "=SUMPRODUCT(R[-2]C" & CL & ":R[-2]C" & CL + 1 ＞＞& ",TRANSPOSE(R" & i & "C[-2]:R" & i + 1 & "C[-2]))"

しかしながらその前のflgの意味と、この下の行のj=j+1が何を意味しているのか理解出来ずにいます。
F8キーを押しながらステップバイステップで確認しながら進んでいますが、まだイメージ出来ません。

よろしかったら簡単なヒントでもいただけないでしょうか？

回答No.9

Wendy02

こんばんは。

ヒントや説明というよりも、偶然に見つけた数式を応用した、マクロのメーキングの話になります。
ただ、もっと良い数式がないものか、なぜ、SUMPRODUCT なのか、良く分かっていないのです。配列(TRANSPORT)に対する配列数式なのです。その部分が最も大事な部分で、後、マクロ自体の構造は、そんなに難しいものではありません。今回は、flg のスイッチなど使わないでも、十分にマクロは付くれるはずです。

　 j = j + 1
　 If j > 3 Then flg = True　'スイッチ（フラグ)

数式には、大きくわけると二種類ありますから、それを入れ別ければよいわけです。flg は、ステップモードで最初の4つの式を入れてみれば分かりますが、最初の4つのセルの数式だけが違う数式を入れています。後は、別の数式を入れるようにしています。

FormulaArray というのは、配列数式を入れるためのプロパティです。

なお、配列数式をまとめて入れると、別の配列数式になってしまうので、やむを得ず、ひとつずつ数式を入れるようなコードになってしまいました。

For Each c In Cells(i, CL + 2).Resize(2, 2)

これは分かりますか？

例えば、Range("A1").Resize(2,2)
A1,B1
A2,B2

A1 から、2行・2列に範囲を広げるのが、Resize の働きです。
4つのセルを一回、ぐるっと回るように出来ています。順番は、A1-B1-A2-B2 ですが、同じ数式ですから、順序はどちらでもよいです。For i=1 To 4 のような書き方では、元のループのコードと重なり合って、コードが見にくくなってしまいます。

最初に書いたことと同じことですが、数式さえ分かれば、ぐるぐる回りながら、一つずつ数式を入れる方式でも、十分に出来るはずです。

それと、前の私の発言に遡るのですが、ご質問の意図や目的が良く分からなかったので、#2の発言は、訂正させていただきます。的外れな発言でお詫びいたします。今回のものは、基礎的な知識とかベテランとか関係のないものです。当初の質問では、もっと基礎的な練習用のマクロを想定していました。

回答No.7

Wendy02

こんばんは。

関数で作ってみました。中身を見ればよいのですが、配列の配列ですから、配列の確定をしなければなりませんでしたが、思ったとおり、統一数式が可能でした。

なお、#6 のコードの部分は、以下の方がよいです。

×　.Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Offset(, 2).ClearContents
　　　↓
.Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp).Offset(, 2)).Offset(, 2).ClearContents

図を見ていただければ分かりますが、途中で、0　になってしまいます。

'-------------------------------------------

Sub MacroSample2()
　　Dim i As Long
　　Dim j As Long
　　Dim c As Variant
　　Dim RwCnt As Integer
　　Dim flg As Boolean
　　Const RW As Integer = 5 '初期行
　　Const CL As Integer = 11 '対象列

　　With ActiveSheet
　　　　.Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp).Offset(, 2)).Offset(, 2).ClearContents
　　　　RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count \ 4
　　　　For i = RW + 2 To RW + RwCnt * 4 - 1 Step 2
　　　　　For Each c In Cells(i, CL + 2).Resize(2, 2)
　　　　　　 If flg = False Then
　　　　　　　c.FormulaArray = "=SUMPRODUCT(R[-2]C" & CL & ":R[-2]C" & CL + 1 & ",TRANSPOSE(R" & i & "C[-2]:R" & i + 1 & "C[-2]))"
　　　　　　　j = j + 1
　　　　　　　If j > 3 Then flg = True
　　　　　　 Else
　　　　　　　c.FormulaArray = "=SUMPRODUCT(R[-2]C" & CL + 2 & ":R[-2]C" & CL + 3 & ",TRANSPOSE(R" & i & "C[-2]:R" & i + 1 & "C[-2]))"
　　　　　　 End If
　　　　　Next c
　　　　　　Cells(i + 1, CL + 4).Formula = "=R[-1]C[-2]*RC[-1]-R[-1]C[-1]*RC[-2]"
　　　　Next i
　　End With
End Sub

'-------------------------------------------

お礼

＞RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count \ 4
＞For i = RW + 2 To RW + RwCnt * 4 - 1 Step 2

すいません、この行を以下に変えて計算できたみたいです。

＞RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count \ 2
＞For i = RW + 2 To RW + RwCnt * 2 - 1 Step 2

また質問があればご連絡します。

補足

ご回答ありがとうございます。

実際，一行一行意味を理解しながら、そして具体的にいくつかサンプルを作りながら実行しています。

このコードだと行列が奇数個の時には、最後の行列が計算できません。
これを回避するにはどうしたらいいのか考え中です。

良ければその回答もご教示願えますか？

それと実際の計算では行列内の数字は±5で推移する予定です。

回答No.6

Wendy02

こんばんは。

一応、補足で書かれたコードをチェックして再現してみましたが、どうも、数字によっては、オーバーフローして、数値が出なくなりますね。どの程度の計算をするのかは別としても、Excelでは無理があるかもしれません。私は、VBAを主に使っている者ですから、VBAで回答をしていますが、どちらかというと、ワークシート関数でそんなに難しくない数式で可能のようです。

別に、変数は、配列変数に入れなくてもよいのですが、貼り付けの際に簡単なので、配列変数にしました。

なお、
RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count \ 4

ここの部分は、4列ずつ計算していますから、4桁で割り切れる行数です。

'-------------------------------------------
Sub SampleTest1()
　　Dim i As Long
　　Dim RwCnt As Integer
　　Dim ret(1, 1) As Variant
　　Dim ret2 As Variant
　　Const RW As Integer = 5 '初期行
　　Const CL As Integer = 11 '対象列

　　With ActiveSheet
　　　　.Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Offset(, 2).ClearContents

　　　　RwCnt = .Range(.Cells(RW, CL), .Cells(Rows.Count, CL).End(xlUp)).Rows.Count \ 4

　　　　For i = RW To RW + RwCnt * 4 - 1 Step 2
　　　　　　If IsEmpty(ret(0, 0)) Then
　　　　　　　　ret(0, 0) = .Cells(i, CL).Value * Cells(i + 2, CL).Value + .Cells(i, CL + 1).Value * .Cells(i + 3, CL).Value
　　　　　　　　ret(0, 1) = .Cells(i, CL).Value * Cells(i + 2, CL + 1).Value + .Cells(i, CL + 1).Value * .Cells(i + 3, CL + 1).Value
　　　　　　　　ret(1, 0) = .Cells(i + 1, CL).Value * Cells(i + 2, CL).Value + .Cells(i + 1, CL + 1).Value * .Cells(i + 3, CL).Value
　　　　　　　　ret(1, 1) = .Cells(i + 1, CL).Value * Cells(i + 2, CL + 1).Value + .Cells(i + 1, CL + 1).Value * .Cells(i + 3, CL + 1).Value
　　　　　　　　.Cells(i + 2, CL + 2).Resize(2, 2).Value = ret
　　　　　　　　.Cells(i + 3, CL + 4).Value = ret(0, 0) * ret(1, 1) - ret(0, 1) * ret(1, 0)
　　　　　　　　ret2 = ret
　　　　　　Else
　　　　　　　　ret(0, 0) = ret2(0, 0) * .Cells(i + 2, CL).Value + ret2(0, 1) * .Cells(i + 3, CL).Value
　　　　　　　　ret(0, 1) = ret2(0, 0) * .Cells(i + 2, CL + 1).Value + ret2(0, 1) * .Cells(i + 3, CL + 1).Value
　　　　　　　　ret(1, 0) = ret2(1, 0) * .Cells(i + 2, CL).Value + ret2(1, 1) * .Cells(i + 3, CL).Value
　　　　　　　　ret(1, 1) = ret2(1, 0) * .Cells(i + 2, CL + 1).Value + ret2(1, 1) * .Cells(i + 3, CL + 1).Value
　　　　　　　　.Cells(i + 2, CL + 2).Resize(2, 2).Value = ret
　　　　　　　　.Cells(i + 3, CL + 4).Value = ret(0, 0) * ret(1, 1) - ret(0, 1) * ret(1, 0)
　　　　　　　　ret2 = ret
　　　　　　End If
　　　　Next i
　　End With
End Sub

'-------------------------------------------

回答No.5

Wendy02

補足というか、アドバイスというか……
#2 で、書かせていただいた、話は間違いないのですが、最初にわけも分からないままにマクロを考えたことが、今の私につながつているわけではあるのですが、やっぱり、基本的なことを無視できないのです。

ただ、私自身は、Webサイトは、軒並み失敗していますので、書籍を利用して段階的に覚えました。
今回見せていただいたコードをみて、できれば、テキストで勉強してほしいと思います。

実際、Select で場所を決めてからというのは、記録マクロの延長でしかありません。

今回の内容とは違いますが、まず、最初に覚えるサンプルの例としては、このようなものです。

'-----------------------------------
'標準モジュール(基本)
'------------------------------------
Dim i As Long '←基本はLong
Dim ret As Double 'ワークシートの値を取る場合は、Double 型

For i = 1 To Range("A65536").End(xlUp).Row
　ret = ret + Cells(i , 1).Value * Cells(i , 2).Value
Next i
Cells(i, 1).Value = ret

'------------------------------------
'なぜ、以下のようなことを書いたかというと、以下の方法は、数値化できないようなものでも、最終部分（セルとは限らない)を取れるので、万能だからです。
'------------------------------------

Do

Loop Until ActiveCell.Value = ""

'------------------------------------

補足

そうですね。
基本が抜けていて、やりたい事をその場しのぎで出来たとしても、結局は
それ以上の応用が利かなくなりますね。

時間が無いなかでの要求なので急ぎ過ぎました。

回答No.4

Wendy02

こんばんは。

>２行２列の掛け算の連続

で、マクロを載せていただいたのですが、どういう計算なのでしょうか。
元の表が分かりません。質問したときの表とは違うようです。

K5 からのスタートですが、横計の掛け算ではないようです。

ans11 = ans11 + (a1 * b1 + a2 * b3)

= K5 * K 7 + L5 * L7

と、一行おきの掛け算で、どのようにしていくのでしょうか。複雑でよく分からないのです。行列計算　というものは、どのようなものを指しているのですか？

通常、行列（マトリックス)の計算は、九九のように、縦と横の掛け算ですよね。イメージが分かれば、コードを書くことは出来ますが、今は、分かりません。

今のようなコードですと、a1,a2 ……というような固定式の場合は、変数は、ほとんど必要ないように思います。変数は、計算などの入れ物ですから、使いまわしが利くかどうかです。

>ans11 = ans11 + (a1 * b1 + a2 * b3)

ちょっと面倒に見えるかもしれませんが、このように書いても良いと思うのです。

ans11 = Range("K5").Value * Range("K7").Value + Range("L5").Value * Range("L7").Value

それと、
Dim a1, a2, a3, a4, b1, b2, b3, b4, ans11, ans12, ans13, ans14, gyouretsushiki As Double

と、書いても、gyouretsushiki　だけが、Double 型になって、他の変数は、Variant 型になっています。

補足

長い間、お付き合いいただいてありがとうございます。

２行２列の掛け算なのでおそらくご理解しているマトリクス計算だと思います。

基本的には

a b
c d

という行列と

e f
g h

という行列の掛け算なので
かけるの演算子を除いて表示すると

ae+bg af+bh
ce+dg cf+dh

という配列になります。

＞gyouretsushiki　だけが、Double 型になって、他の変数は、Variant 型になって＞います。

こちらもご指摘ありがとうございます。

回答No.3

Wendy02

こんにちは。

そろそろ、解答を付けておきます。
一応、セルの最大行は、65536として、扱われています。
横計は掛け算にして、それを加算しています。
'----------------------------------------------
Sub Macro1()
　　'入門用
　　Dim a, b, c
　　Range("B1").Select
　　Do
　　　　a = ActiveCell
　　　　b = ActiveCell.Offset(0, 1)
　　　　c = c + a * b
　　　　ActiveCell.Offset(1, 0).Select
　　Loop Until ActiveCell = ""
　　ActiveCell = c
End Sub
'----------------------------------------------
Sub Macro2()
　　'中級編1
　　Dim c As Variant
　　Dim dblSum As Double
　　Dim r As Range
　　Set r = Range("B65536").End(xlUp)
　　For Each c In Range("B1", r)
　　　　dblSum = dblSum + c.Value * c.Offset(, 1).Value
　　Next c
　　r.Offset(1).Value = dblSum
　　Set r = Nothing
End Sub
'----------------------------------------------
Sub Macro3()
　　'中級編2
　　Dim r As Range
　　Dim rng As Range
　　Set r = Range("B65536").End(xlUp)
　　Set rng = Range("B1", r)
　　r.Offset(1).Value = _
　　　 WorksheetFunction.SumProduct(rng, rng.Offset(, 1))
　　Set rng = Nothing
End Sub

'----------------------------------------------

補足

入門用を応用して作って見ました。
２行２列の掛け算の連続なので順番に処理したいのですが、
これ以上どうにもならない実力です。
２行２列があるぶん計算するにはどう直せばいいのでしょうか？

Private Sub CommandButton1_Click()
'入門用
Dim a1, a2, a3, a4, b1, b2, b3, b4, ans11, ans12, ans13, ans14, gyouretsushiki As Double
Range("K5").Select

a1 = ActiveCell
a2 = ActiveCell.Offset(0, 1)
a3 = ActiveCell.Offset(1, 0)
a4 = ActiveCell.Offset(1, 1)
b1 = ActiveCell.Offset(2, 0)
b2 = ActiveCell.Offset(2, 1)
b3 = ActiveCell.Offset(3, 0)
b4 = ActiveCell.Offset(3, 1)
ans11 = ans11 + (a1 * b1 + a2 * b3)
ans12 = a1 * b2 + a2 * b4
ans13 = a3 * b1 + a4 * b3
ans14 = a3 * b2 + a4 * b4
ActiveCell.Offset(2, 2).Select

ActiveCell = ans11
ActiveCell.Clear
Range("m7").Value = ans11
Range("n7").Value = ans12
Range("m8").Value = ans13
Range("n8").Value = ans14

Dim c1, c2, c3, c4, ans21, ans22, ans23, ans24 As Double

c1 = ActiveCell.Offset(2, -2)
c2 = ActiveCell.Offset(2, -1)
c3 = ActiveCell.Offset(3, -2)
c4 = ActiveCell.Offset(3, -1)

Do
ans21 = ans21 + ans11 * c1 + ans12 * c3
ans22 = ans22 + ans11 * c2 + ans12 * c4
ans23 = ans23 + ans13 * c1 + ans14 * c3
ans24 = ans24 + ans13 * c2 + ans14 * c4
ActiveCell.Offset(4, -2).Select
Loop Until ActiveCell = ""

ActiveCell = ans21
ActiveCell.Clear
Range("m9").Value = ans21
Range("n9").Value = ans22
Range("m10").Value = ans23
Range("n10").Value = ans24

gyouretsushiki = ans21 * ans24 - ans22 * ans23
Range("p10").Value = gyouretsushiki

End Sub

回答No.2

Wendy02

こんにちは。

質問の意図はだいたい分かるけれども（たぶん、足し算するわけですよね)、同様の問題を、私は、パソコンスクールでマクロを習った日の初日に出た宿題でした。私は、数時間掛かって、めちゃめちゃな内容ではあったけれども、曲がりなりにも、それを解きました。もちろん、プログラミングも知らない状態でした。別に自慢するのではありませんが、このレベルになると、その内容如何によっては、分かるから教えるというのには、ちょっと、そのまま回答するのは軽率というか、抵抗があります。

とはいえ、誰かが回答してしまうとは思います。

初歩的な方法としては、
Do

Loop Until ActiveCell.Value = ""

こんなスタイルになるのでは？
関数での処理の解答は、初級レベルでは、本当は不可です。そういうやり方をすると上達しません。

お礼

なるほど、そうなんですね。
まだまだ、初級、中級などレベルづけができません。
いわゆる入門レベルです。
一応、出来る限り自分で調べようとはしていますが、それでもどういう手法がいいのかわからないので、そういうちょっとしたヒントを求めて質問しています。
試してみます。ありがとうございました。

回答No.1

某HN クロメート(Chromate)（@CoalTar）

実際の計算結果は？
＞２行２列の行列を所望の回数だけ計算させる
どのような計算を行うのですか？
足し算、掛け算？

補足

すいません、基本的な情報抜けていました。
掛け算です。