Excel VBA質問箱 IV

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

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


48950 / 76732 ←次へ | 前へ→

【32708】Re:すいません。
発言  やっちん  - 05/12/21(水) 8:50 -

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


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 "計算終了。結果はシート2だす。"
End Sub

0 hits

【32646】何が間違えてるか教えてください。 素人 05/12/20(火) 13:06 質問
【32649】Re:何が間違えてるか教えてください。 やっちん 05/12/20(火) 14:01 発言
【32651】すいません。 素人 05/12/20(火) 14:07 発言
【32652】Re:すいません。 やっちん 05/12/20(火) 14:17 発言
【32653】Re:すいません。 素人 05/12/20(火) 14:36 発言
【32654】Re:すいません。 やっちん 05/12/20(火) 14:40 発言
【32708】Re:すいません。 やっちん 05/12/21(水) 8:50 発言
【32677】Re:何が間違えてるか教えてください。 ni 05/12/20(火) 18:07 回答
【32696】Re:何が間違えてるか教えてください。 素人 05/12/20(火) 23:22 発言
【32700】Re:何が間違えてるか教えてください。 ni 05/12/21(水) 0:53 発言
【32751】Re:何が間違えてるか教えてください。 素人 05/12/21(水) 16:42 発言
【32761】Re:何が間違えてるか教えてください。 ni 05/12/21(水) 17:52 発言

48950 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free