• ベストアンサー

2つの正電荷をおびた粒子がバネでつながっている物体のシュミレーション

こんにちは。 2つの正電荷をおびた粒子がバネでつながっている物体について、粒子をランダムな位置において離し、停止(ダンピングあり)するまでの過程をシミュレーションしたいのですが、どうもうまく行きません。 ちなみに空間は二次元(平面)です。 ある資料をもとに下記のVBAをコーディングしたのですが(簡単にしてあります)、力の向きをどういう風に反映させたらいいのかわかりません。 どうしたらいいでしょうか。。。 漠然としていてすみません。 粒子=Node1, Node2 { 'クーロン反発力を計算するための関数 Public Function AddCoulombRepulsion() Dim xyIdx As Integer Dim distance As Double For xyIdx = 1 To 2 '距離を計測 distance = Abs(Node1.position(xyIdx) - Node2.position(xyIdx)) 'クーロン反発力を計算 Node1.netForce(xyIdx) = Coulomb定数 * Node1.電荷 * Node2.電荷 / distance ^ 2 Next xyIdx End Function 'フック張力を計算するための関数 Public Function AddHookeAttraction() Dim xyIdx As Integer Dim distance As Double For xyIdx = 1 To 2 '距離を計測 distance = Abs(Node1.position(xyIdx) - Node2.position(xyIdx)) 'バネによる張力を計算 Node1.netForce(xyIdx) = ( -1 ) * (Spring1.バネ定数 * distance) Next xyIdx End Function } 上記をNode1とNode2を逆にして再度行います。 { 'netForceから速度を計算 For xyIdx = 1 To 2 Node1.velocity(xyIdx) = (Node1.velocity(xyIdx) + timestep * Node1.netForce(xyIdx) / Node1.Mass) * Damping '※0 < Damping < 1 Next xyIdx 'velocityから位置を計算 For xyIdx = 1 To 2 Node1.position(xyIdx) = Node1.position(xyIdx) + timestep * Node1.velocity(xyIdx) Next xyIdx 'totalKineticEnergyに加算 For xyIdx = 1 To 2 totalKineticEnergy = totalKineticEnergy + Node1.Mass * (Node1.velocity(xyIdx)) ^ 2 Next xyIdx } Node1をNode2にして上記を繰り返します。 これを、totalKineticEnergyが一定値より小さくなるまでループさせる予定です。(totalKineticEnergyは毎ループの頭で0に初期化します)停止したときのNode1の位置とNode2の位置が知りたいのですが。。。 ご助言よろしくお願いいたしますm(_ _)m

質問者が選んだベストアンサー

  • ベストアンサー
  • htms42
  • ベストアンサー率47% (1120/2361)
回答No.3

文章を読む限り、バネは1つですね。 バネが振動しながら減衰していく途中の時間変化を数値的に求めようとしているのだと思います。でもこれはシミュレーションとは言わないと思います。ランダムというのは任意の初期条件という意味ですね。確率的に起こる現象を想定しているわけではないでしょう。 バネでぶら下がった錘が振動しているのとの違いは重力かクーロン力かです。重力は距離によらず一定ですがクーロン力は距離と共に小さくなります。つりあいの位置に関して力が非対称ですね。 振動の特徴を知ることと減衰項の考慮の仕方を勉強するためであれば 1次元で(ぶら下がっているバネ、水平に置かれているバネ)でやられてもいいのではと思います。 2次元ということは特に意味を持っていないという印象です。 速度に比例する抵抗がある場合の自由落下は微分方程式を解くことができますので数値的に解く方法の確認に使うことが出来ます。 timestepごとに力、加速度、速度、位置と求めていけばいいだけです。 この場合は振動ではありませんからダンピング項の扱いの練習になります。 運動方程式は ma=mg-γv t=0でv=0 として解くと v=(mg/γ)(1-exp(-γt/m)) です。 減衰項のある場合の調和振動も微分方程式が解けているはずですから対応が可能でしょう。この場合は振動ですから停止の判断が問題になります。「運動エネルギー=0」という条件では不足です。振動の途中で速度=0が起こるからです。 「全エネルギー=弾性エネルギー+運動エネルギー」 です。止まった時はつりあいの位置になっていますから 「全エネルギー≧つりあいの位置での弾性エネルギー」 が静止の判定基準になるはずです。 >totalKineticEnergy = totalKineticEnergy + Node1.Mass * (Node1.velocity(xyIdx)) ^ 2 この式は運動エネルギーだけしか考慮されていませんから停止の判定条件としては不足だと思います。

foxa-gogo
質問者

補足

本当は、扱っているのは複数の粒子が複数のバネでつながったネットワークです。 現実世界に即していなくても、ネットワークがうまいこと広がればそれでいいのですが。。。

その他の回答 (2)

  • rabbit_cat
  • ベストアンサー率40% (829/2062)
回答No.2

>一応(xyIdx)が1または2で、それぞれxとyを表しています。 なるほど。じゃあ、このままでOKなのでは。 ただし、 >Dampingは0次元? >だと思います(^^;) >Node1.velocity(xyIdx) = (Node1.velocity(xyIdx) + timestep * Node1.netForce(xyIdx) / Node1.Mass) * Damping この式だとDampingは無次元になってないですよ。(パッと見は無次元になっているように見えますが、よく考えるとおかしい) この式だと、ループ毎に、速度がDamping倍になっていくわけですが、ループ1回の時間がtimestep秒なわけですよね。ここで、もしtimestepが1/2になったら、Dampingは1/2も1/2にならないとおかしくないですか? そもそも、ダンピングというのは、普通は、速度に比例する力が物体にかかる場合をいうことが多いのですが。 Node1.velocity(xyIdx) = Node1.velocity(xyIdx) + timestep * (Node1.netForce(xyIdx) - Damping*Node1.velocity(xyIdx)) / Node1.Mass とか。 示された式だと、速度自体が、そのときの速度に比例して減っていくことになっています。本当にそういう系ですか?

foxa-gogo
質問者

補足

う~ん、どうなんでしょう(^^;) 元ネタにあった通りにやってみたのですが。。。 元ネタはこれです↓(wikipedia: http://en.wikipedia.org/wiki/Force-based_algorithms) Each node has x,y position and dx,dy velocity and mass m. There is usually a spring constant, s, and damping: 0 < damping < 1. The force toward and away from nodes is calculated according to Hooke's Law and Coulomb's law or similar as discussed above. set up initial node velocities to (0,0) set up initial node positions randomly // make sure no 2 nodes are in exactly the same position loop total_kinetic_energy := 0 // running sum of total kinetic energy over all particles for each node net-force := (0, 0) // running sum of total force on this particular node for each other node net-force := net-force + Coulomb_repulsion( this_node, other_node ) next node for each spring connected to this node net-force := net-force + Hooke_attraction( this_node, spring ) next spring // without damping, it moves forever this_node.velocity := (this_node.velocity + timestep * net-force) * damping this_node.position := this_node.position + timestep * this_node.velocity total_kinetic_energy := total_kinetic_energy + this_node.mass * (this_node.velocity)^2 next node until total_kinetic_energy is less than some small number //the simulation has stopped moving

  • rabbit_cat
  • ベストアンサー率40% (829/2062)
回答No.1

>Node1.velocity(xyIdx) = (Node1.velocity(xyIdx) + timestep * Node1.netForce(xyIdx) / Node1.Mass) * Damping Damping という定数の(物理量としての)次元はなんですか? timestepがかかってないとかなり変な感じです。 >力の向きをどういう風に反映させたらいいのかわかりません 単純にやるなら、粒子の位置や力を2次元ベクトルで表わせばいいです。

foxa-gogo
質問者

補足

Dampingは0次元? だと思います(^^;) 一応(xyIdx)が1または2で、それぞれxとyを表しています。

関連するQ&A

  • 一次元静電粒子コードについて・・

    一度物理学のところで質問したのですが、誰も答えてくれなかったので(ずうずうしいとは思いますが)今度はこちらで質問させていただきます。 これは、VBで作ってみたPICコードというものなのですが(電界と粒子の運動の関係のコードです)、このコードでは右側の図にSin(正弦)波形が出力されます。この波形を変えたいのですが、どこを変えればいいのでしょう?私は、ポテンシャルの初期値を変えればいいと思い何度もチャレンジしましたが、うまくいきません。 どなたか分かる方教えてください!! (つづきがあります。) '一次元静電粒子コード M = 3:IM = 2 ^ (M + 1) + 1:IM2 = IM * 2 - 1 Dim RO(18):Dim PHI(18):Dim A(18, 4):Dim E(18):Dim X(161):Dim V(161) ' X:電子の位置(X座標) V:電子の速度 RO:電荷密度 ' A(I,J):ポアソン・マトリックスエレメント PHI:静電ポテンシャル ' E:静電界(X方向) NP:1セル当りの粒子数 XMAX:全メッシュ数 ' KK:最大計算回数 DT:タイムステップ XMAX:X方向の最大値点 ' DX: メッシュ間隔 NP = 10:NPT = NP * (IM - 1):PW = 1 / NP XMAX = IM - 1:DX = XMAX / (IM - 1):DXP = DX / NP:DT = 0.1 ' 粒子の初期設定 For IP = 1 To NPT X(IP) = DXP * (IP - 0.5):V(IP) = 0 Next IP ' ポテンシャルの初期値 For I = 1 To IM PHI(I) = 5! * Sin(2 * 3.14159 * (I - 1) / (IM - 1)) Next I ' 計算開始 For KK = 1 To 120 ' 電場の計算 For I = 1 To IM - 1 E(I) = -(PHI(I + 1) - PHI(I)) / DX Next I E(IM) = E(1):E(0) = E(IM - 1):E(IM + 1) = E(2) つづく・・・

  • 一次元静電粒子コードについて・・

    これは、VBで作ってみたPICコードなのですが、このコードではSin波形が出力されます。この波形を変えたいのですが、どこを変えればいいのでしょう? どなたか分かる方教えてください。 (つづきがあります。) '一次元静電粒子コード M = 3:IM = 2 ^ (M + 1) + 1:IM2 = IM * 2 - 1 Dim RO(18):Dim PHI(18):Dim A(18, 4):Dim E(18):Dim X(161):Dim V(161) ' X:電子の位置(X座標) V:電子の速度 RO:電荷密度 ' A(I,J):ポアソン・マトリックスエレメント PHI:静電ポテンシャル ' E:静電界(X方向) NP:1セル当りの粒子数 XMAX:全メッシュ数 ' KK:最大計算回数 DT:タイムステップ XMAX:X方向の最大値点 ' DX: メッシュ間隔 NP = 10:NPT = NP * (IM - 1):PW = 1 / NP XMAX = IM - 1:DX = XMAX / (IM - 1):DXP = DX / NP:DT = 0.1 ' 粒子の初期設定 For IP = 1 To NPT X(IP) = DXP * (IP - 0.5):V(IP) = 0 Next IP ' ポテンシャルの初期値 For I = 1 To IM PHI(I) = 5! * Sin(2 * 3.14159 * (I - 1) / (IM - 1)) Next I ' 計算開始 For KK = 1 To 120 ' 電場の計算 For I = 1 To IM - 1 E(I) = -(PHI(I + 1) - PHI(I)) / DX Next I E(IM) = E(1):E(0) = E(IM - 1):E(IM + 1) = E(2) ' 粒子の運動 For IP = 1 To NPT XNM = X(IP) / DX + 0.5:IXP = Int(XNM):IXM1 = IXP - 1 If IXM1 <= 0 Then IXM1 = IM - 1 - IXM1: B = XNM - IXP If IXP = 0 Then IXP = IM - 1:EP = E(IXP) * B + E(IXM1) * (1 - B) V(IP) = V(IP) + Q * EP * DT: X(IP) = X(IP) + V(IP) * DT If X(IP) > XMAX Then X(IP) = X(IP) - XMAX If X(IP) < 0 Then X(IP) = XMAX + X(IP) Next IP つづく・・・

  • TreeViewに重複する値をセット

    VB2005Expressで開発しています。 TreeViewにデータテーブルの値をセットして表示しています。 セットする値に重複する値がある場合、ツリーの構造が崩れてしまいます。左図のようにしたいのですが、右図のようになってしまいます。 あ あ |-い |-い | | | | | -う | -う お | -え |-い お | | | -え ツリーの値に非表示のキーを持たせる等、何か対応法をご存知の方が いらっしゃいましたら教えて下さい。下記がPGMです。 '処理内容:TreeViewにデータテーブルの値をセット Private Function fncTreeViewSet() As Boolean Dim dTbl As DataTable Dim Node As TreeNode Dim intMenuNo As Integer Dim strMenuName1 As String Dim strMenuName2 As String Dim strMenuName3 As String Dim strMenuName4 As String Dim strMenuName5 As String Dim i As Integer Node = TreeView1.SelectedNode dTbl = dsDataSet.Tables("Mメニュー") For i = 0 To dTbl.Rows.Count() - 1 intMenuNo = 0 strMenuName1 = "" strMenuName2 = "" strMenuName3 = "" strMenuName4 = "" strMenuName5 = "" strMenuName1 = Trim$(dTbl.Rows(i)("階層1")) intMenuNo = dTbl.Rows(i)("工程番号") strMenuName2 = Trim$(dTbl.Rows(i)("階層2").ToString) strMenuName3 = Trim$(dTbl.Rows(i)("階層3").ToString) strMenuName4 = Trim$(dTbl.Rows(i)("階層4").ToString) strMenuName5 = Trim$(dTbl.Rows(i)("階層5").ToString) If strMenuName1 = "" Then Else If strMenuName2 = "" Then TreeView1.Nodes.Add(strMenuName1) '階層1をセット Else If strMenuName3 = "" Then fncSerchNode(strMenuName1) TreeView1.SelectedNode.Nodes.Add(strMenuName2) '階層2をセット Else If strMenuName4 = "" Then fncSerchNode(strMenuName2) TreeView1.SelectedNode.Nodes.Add(strMenuName3) '階層3をセット Else If strMenuName5 = "" Then fncSerchNode(strMenuName3) TreeView1.SelectedNode.Nodes.Add(strMenuName4) '階層4をセット Else fncSerchNode(strMenuName4) TreeView1.SelectedNode.Nodes.Add(strMenuName5) End If End If End If End If End If Next TreeView1.SelectedNode = Nothing End Function '処理内容:指定ノード選択 Private Function fncSerchNode(ByVal strMenuName As String) As Boolean Dim Node As TreeNode For Each Node In fncGetAllNodes(TreeView1.Nodes) If Node.Text = strMenuName Then TreeView1.SelectedNode = Node Exit For End If Next End Function '処理内容:子ノードも含んだすべてのノードを取得 Private Function fncGetAllNodes(ByVal Nodes As TreeNodeCollection) As ArrayList Dim Ar As New ArrayList Dim Node As TreeNode For Each Node In Nodes Ar.Add(Node) If Node.GetNodeCount(False) > 0 Then Ar.AddRange(fncGetAllNodes(Node.Nodes)) End If Next Return Ar End Function

  • Excel VBAライフゲーム

    ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。 もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。 続きのプログラムを教えていただけたら幸いです。 Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const SIZE As Integer = 19 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim N As Integer Dim Cnext(SIZE, SIZE) As Integer Dim I As Integer, J As Integer InitRate = -1 Do While InitRate < 0 Or 1 < InitRate Loop For I = 0 To SIZE For J = 0 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 0 To SIZE For J = 0 To SIZE If C(I, J) = ALIVE Then Cells(I + 1, J + 1).Value = "■" Else Cells(I + 1, J + 1).Vallue = "" End If Next J Next I For I = 0 To SIZE For J = 0 To SIZE N = Count(I, J) Next J Next I For I = 0 To SIZE For J = 0 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Count(I As Integer, J As Integer) As Integer End Function

  • vbaでオーバーフローしてしまいました。

    Dim i As Long Dim k As Long For i = 1 To 829 For k = 1 To 995 Worksheets("2").Cells(k,i) = Worksheets("1").Cells(k,i) /Worksheets("1").Cells(996,i) Next k Next i これを実行したらオーバーフローしてしまい、途中までしか計算できませんでした。 解決方法を教えて頂きたいです。よろしくお願いします。

  • エクセルマクロで定義した関数が動きません

    以前にマクロの記述について教えて頂いた件の続きになります. ご指導頂いたとおりExcelマクロで複素数を扱う関数を下記HPから 標準モジュールにコピペしました.今度は正しくコピーできたと思いますが, 実行するとエラーになります. 標準の組込み関数を用いて「実数」の行列を計算すれば正しく 計算できますが,当然ながら「複素数」は計算できません. この「複素数」を扱う新しく定義した関数が動かない理由, 「End if に対するifブロックがありません」とか 計算結果が「#VALUE!」となってしまうのは何故でしょうか? マクロの記述内容はほとんど理解できないのですが, どなたか助けて頂けませんか! ちなみにエクセルは2016版です. http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 以下はコピー定義した「 IMMULT」関数と「 IMINVERS」関数のマクロです. Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 'End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function

  • 2次元配列を返す関数について

    VB6でExcelのMMULTのような関数が欲しかったので作って見ました。 関数内で配列をRedimで確保して戻り値として返すのですが、このような方法でメモリーリークなど発生する心配はないでしょうか? '行列の掛け算 Public Function mtxMult(ByRef mx1() As Double, ByRef mx2() As Double) As Double() Dim r, c, i, r1, c1, r2, c2 Dim res() As Double '行と列の最大値を得る r1 = UBound(mx1, 1) c1 = UBound(mx1, 2) r2 = UBound(mx2, 1) c2 = UBound(mx2, 2) If c1 <> r2 Then Exit Function ReDim res(0 To r1, 0 To c2) '答えの配列を確保 '各要素を掛ける For r = 0 To r1 For c = 0 To c2 res(r, c) = 0 For i = 0 To c1 res(r, c) = res(r, c) + mx1(r, i) * mx2(i, c) Next i Next c Next r mtxMult = res End Function '動作確認 Private Sub Command1_Click() Dim mx1(0 To 1, 0 To 1) As Double Dim mx2(0 To 1, 0 To 1) As Double Dim res() As Double Dim r As Integer List1.Clear mx1(0, 0) = 1 mx1(0, 1) = 2 mx1(1, 0) = 3 mx1(1, 1) = 4 mx2(0, 0) = 5 mx2(0, 1) = 6 mx2(1, 0) = 7 mx2(1, 1) = 8 res = mmult(mx1, mx2) For r = 0 To 1 List1.AddItem res(r, 0) & " , " & res(r, 1) Next r End Sub ところで、質問のソースコードのインデントを保持する方法はないでしょうか?

  • グリッドの使い方について

     VB初心者です。 Excelからデータをグリッドに取り込んでグリッドで計算しているのですが、x(i, j) = MSFlexGrid1.TextMatrix(i, j) の文がいろいろ入力してみたのですが、エラーが出てしまいます。  それと計算するときに最初のセルを(3,3)などにしたい時にどうすれば良いのかわかりません。 教えていただければ幸いです。よろしくお願いします。 Dim goukei(10) As Double Dim x(20, 10) As Double For i = 1 To 20 For j = 1 To 10 x(i, j) = MSFlexGrid1.TextMatrix(i, j) Next j Next i For j = 1 To 10 goukei(j) = 0 Next j For i = 1 To 20 For j = 1 To 10 goukei(j) = goukei(j) + x(i, j) Next j Next i For j = 1 To 10 Text1.Text = goukei(j) Next j

  • エクセルマクロ配列で変数は使えますか

    エクセル2013です。 初めて配列を使います。 以下のように作成し思ったようにできました。 Sub 計算() '成功 Dim a As Integer Dim c As Integer Dim b(5) As Integer Dim 最終行 Dim 値列  値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To 5 b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub ただ計算する列の範囲をインプットボックスで入力した値 にしたい為以下のように改造しました。 Dim b(対象列) As Integerでエラーになります 配列には変数は使用できないのでしょうか? よろしくお願いします。 Sub 計算() '失敗 Dim a As Integer Dim c As Integer Dim b(対象列) As Integer’★ここでERRになる Dim 最終行 Dim 対象列 Dim 値列  対象列 = 22'インプットボックスで入力した値 値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To (対象列 - 17) b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub

  • Excelマクロの配列計算が♯VALUE!となる

    Excelマクロの複素数を扱う配列計算がエラーとなります.  下記HPからマクロを標準モジュールに取り込み,以前のQAで助けて頂き 一部修正により動作するようになりました. しかし,このマクロで定義した「 IMINVERS 」関数を実行すると,大きい 配列では「#VALUE!」となってしまいます. 助けて頂けませんか! http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 〔問題の現象〕  整数の行列(6×6)以上の配列計算は「#VALUE!」となる.  複素数の行列(5×5)以上の配列計算は「#VALUE!」となってしまう. 小さい配列では正しく計算できているので,手順には問題ないようにみえます. どこに問題があるのでしょうか. 問題の「 IMINVERS」関数に関するマクロは以下の通りです。 ----------------------------------------------------------- Public Function IMABSa(a As Variant) As Variant IMABSa = Application.WorksheetFunction.ImAbs(a) End Function Public Function IMDIVa(a As Variant, b As Variant) As Variant IMDIVa = Application.WorksheetFunction.ImDiv(a, b) End Function Public Function IMPRODUCTa(ParamArray a()) As Variant IMPRODUCTa = Application.WorksheetFunction.ImProduct(a) End Function Public Function IMPRODUCTb(a As Variant, b As Variant) As Variant IMPRODUCTb = Application.WorksheetFunction.ImProduct(a, b) End Function Public Function IMSUBa(a As Variant, b As Variant) As Variant IMSUBa = Application.WorksheetFunction.ImSub(a, b) End Function Public Function IMSUMa(ParamArray a()) As Variant IMSUMa = Application.WorksheetFunction.ImSum(a) End Function Public Function IMSUMb(a As Variant) As Variant IMSUMb = Application.WorksheetFunction.ImSum(a) End Function ----------------------------------------------------- Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function ------------------------------------------------