Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48954 / 76736

←次へ　｜　前へ→


	【32708】Re:すいません。

やっちん - 05/12/21(水) 8:50 -


	引用なし

	パスワード

▼素人さん：
a()とd()は
平行して同じ処理をする必要があります。
ループもなぜか１つ多い気がしますね。
私にはこれが限界かな。

Sub gyaku()
　　Dim n As Integer
　　Dim a() As Double, d() As Double
　　Dim i As Integer, j As Integer, k As Integer, l As Integer
　　Dim ip As Integer
　　Dim p As Double, r As Double

　　With Worksheets("Sheet1")
　　　　n = .Cells(2, 3)
　　End With
　　ReDim d(n, n) As Double
　
　　With Worksheets("Sheet2")
　　　　For i = 1 To n
　　　　　　For l = 1 To n
　　　　　　　　If i = l Then
　　　　　　　　　　d(i, l) = 1
　　'　　　　　　　　.Cells(i, 2 * n + j) = d(i, l)
　　　　　　　　　　.Cells(i, 2 * n + l) = d(i, l)
　　　　　　　　Else
　　　　　　　　　　d(i, l) = 0
　　'　　　　　　　　.Cells(i, 2 * n + j) = d(i, l)
　　　　　　　　　　.Cells(i, 2 * n + l) = d(i, l)
　　　　　　　　End If
　　　　　　Next l
　　　　Next i
　　End With
　　ReDim a(n, n) As Double
'　　ReDim d(n, n) As Double
　　MsgBox "計算開始。行列サイズは" & n & "だす。"
　
　　With Worksheets("Sheet2")
　　　　For i = 1 To n
　　　　　　For j = 1 To n
　　　　　　　　a(i, j) = .Cells(i, j).Value
　　　　　　Next j
　　　　Next i
　　End With
　　
'　　With Worksheets("Sheet2")
'　　　　For i = 1 To n
'　　　　　　For l = 1 To n
'　　　　　　　　d(i, l) = .Cells(i, 2 * n + l).Value
'　　　　　　Next l
'　　　　Next i
'　　End With
　
　
'　　For l = 1 To n

　　For k = 1 To n
　
　
　　　　p = 0
　　　　ip = 0
　　　　For i = k To n
　　　　　　If p < Abs(a(i, k)) Then
　　　　　　　　p = Abs(a(i, k))
　　　　　　　　ip = i
　　　　　　　　Exit For
　　　　　　End If
　　　　Next i
　　　　If ip = 0 Then
　　　　　　MsgBox "行列が得意である(PIVOT=0)", vbCritical
　　　　　　Exit For
　　　　End If
　　
　　　　If ip > k Then
　　　　　　For j = k To n
　　　　　　　　swap a(k, j), a(ip, j)
　　　　　　　　swap d(k, j), d(ip, j)
　　　　　　Next j
'　　　　　　swap d(k, l), d(ip, l)
　　　　End If
　　
　　　　r = a(k, k)
'　　　　For j = k To n
　　　　For j = 1 To n
　　　　　　a(k, j) = a(k, j) / r
　　　　　　d(k, j) = d(k, j) / r '*
　　　　Next j
　　
'　　　　d(k, l) = d(k, l) / r
　　
'　　　　For i = k To n
　　　　For i = 1 To n
　
　　　　　　If i <> k Then
　　　　　　　　r = a(i, k)
'　　　　　　　　For j = k To n
　　　　　　　　For j = 1 To n
　　　　　　　　　　a(i, j) = a(i, j) - r * a(k, j)
　　　　　　　　　　d(i, j) = d(i, j) - r * d(k, j) '*
　　　　　　　　Next j
'　　　　　　　　d(i, l) = d(i, l) - r * d(k, l)
　　
　　　　　　End If
　　　　Next i
　
　　Next k
'Next l

　　With Worksheets("Sheet2")
　　　　For l = 1 To n
　　　　　　For i = 1 To n
　　　　　　　　.Cells(i, n + l) = d(i, l)
　　　　　　Next i
　　　　Next l
　　End With
　　MsgBox "計算終了。結果はシート２だす。"
End Sub

0 hits

▼

【32646】何が間違えてるか教えてください。 素人 05/12/20(火) 13:06