下面是小弟的程式碼 現在的問題是我在程式中有註解的那個列印矩陣的副程式裡所列印出來的m(i,j)跟我在程式開頭那個曲線方程式的注解下方的m(i,1),m(i,2),m(i,3)所列印出來的值不同,但我想兩者應該是相同的才是,因為我是先執行一個再載入另一個才執行的小弟實在不知道為什麼會如此 請高手幫幫忙~~~

Private Sub Command1_Click()
Dim Keyin As String, m() As Single, x() As Single, TreatStr As Single, k As Double, SepStr() As String
   Keyin = InputBox("請輸入方陣,以分號"";""來分隔列元素,以空白來分隔欄元素。" _
        & vbNewLine & "例如有一3×3的方陣:" & vbNewLine & "1 2 3 " & vbNewLine & _
        "4 5 6 " & vbNewLine & "7 8 9 " & vbNewLine & "則輸入: 1 2 3;4 5 6;7 8 9 ", , "0 -1 3;1 0 -2;4 0 2")
   If SepStrToMatrix(Keyin, ";", " ", m, SepStr) Then
     
         'Debug.Print
     Call MIMP(m, x)
     Call PrintMatrix(x)
     ' Call PrintMatrix(m) '測試m是否為單位矩陣之用
       Else
     MsgBox "方陣輸入有誤,請重新輸入。"
   End If
      
'曲線方程式
 Dim pp() As Single, g() As Single, h() As Single, f() As Single, e() As Single, r As Double, o As Double, q As Single
  ReDim g(1 To UBound(m))
  ReDim h(1 To UBound(m))
  ReDim f(1 To UBound(m))
  ReDim e(1 To UBound(m))
  ReDim pp(1 To UBound(m))
  ReDim px(1 To UBound(m))
  ReDim py(1 To UBound(m))
  ReDim pz(1 To UBound(m))
  Dim i As Long, ii As Long
 For ii = 1 To UBound(SepStr)
  For i = 1 To UBound(SepStr)
    px(ii) = m(i, 1)
   ' Debug.Print px(ii)
     Next
    For i = 1 To UBound(SepStr)
    py(ii) = m(i, 2)
    Debug.Print py(ii)
   Next
    For i = 1 To UBound(SepStr)
    pz(ii) = m(i, 3)
    Next
    Next
  
'  f(r) = 3 * (h(r + 1) - h(r)) - (2 * g(r) + g(r + 1))
'  e(r) = 2 * (h(r) - h(r + 1)) + g(r) + g(r + 1)
 t = 1
'pp(r) = e(r) * t ^ 3 + f(r) * t ^ 2 + g(r) * t + h(r)

Next
'Next
'Next
' Next
End Sub

'IsNumeric會將含有逗號的數值判斷為true,所以If Not IsNumeric(temp) Or InStr(temp, ",") > 0 Then Exit Function
Public Function SepStrToMatrix(TreatStr As String, RowSepChr As String, ColSepChr As String, ReturnValue() As Single, SepStr() As String) As Boolean
If StrComp(RowSepChr, ColSepChr, vbBinaryCompare) = 0 Then MsgBox "列和欄的分隔字元不可相同"
   Dim i As Long, j As Long, k As Long, temp As String, no As Long, row As Long
   TreatStr = Trim(TreatStr)
   Do
     no = no + 1
     ReDim Preserve SepStr(1 To no)
     i = InStr(j + 1, TreatStr, RowSepChr, vbBinaryCompare)
     If i <> 0 Then
        SepStr(no) = Trim(Mid(TreatStr, j + 1, i - j - 1))
     Else
        SepStr(no) = Trim(Mid(TreatStr, j + 1))
       
     End If
     j = i
     m = 1
 
   Loop Until i = 0
   row = no
   ReDim ReturnValue(1 To row, 1 To 1)
   For k = 1 To row
   no = 0
     Do
        i = InStr(j + 1, SepStr(k), ColSepChr, vbBinaryCompare)
        If i <> j + 1 Then
          no = no + 1
          If i <> 0 Or (i = 0 And j < Len(SepStr(k))) Then
             If i <> 0 Then temp = Mid(SepStr(k), j + 1, i - j - 1) Else temp = Mid(SepStr(k), j + 1)
             If Not IsNumeric(temp) Or InStr(temp, ",") > 0 Then Exit Function
             If no > UBound(ReturnValue, 2) Then ReDim Preserve ReturnValue(1 To row, 1 To no)
             ReturnValue(k, no) = temp
          End If
        End If
        j = i
     Loop Until i = 0
   Next
   SepStrToMatrix = True
End Function
'以下是列印矩陣的副程式
Public Sub PrintMatrix(m() As Single)
Dim i As Long, j As Long, Keyin As Single
   Debug.Print
   For i = 1 To UBound(m, 1)
      For j = 1 To UBound(m, 2)
     ' i = i + 1
        Debug.Print m(i, j);
        Next
      Debug.Print
   Next
  
End Sub

Public Sub MIMP(m() As Single, ReturnValue() As Single)
Dim i As Long, j As Long, k As Long, n As Long
   Dim r() As Long, c() As Long, row As Long, temp() As Single ', temp2() As Single '測試m是否為單位矩陣之用
   Dim Pivot As Single, NoCompare As Boolean
   row = UBound(m, 1)
   If row <> UBound(m, 2) Then MsgBox "矩陣輸入有誤": Exit Sub
   ReDim r(1 To row), c(1 To row), temp(1 To row), temp2(1 To row), ReturnValue(1 To row, 1 To row)
   For i = 1 To row
     ReturnValue(i, i) = 1
   Next
   For i = 1 To row
     Pivot = 0
     NoCompare = False
     For j = 1 To row
        For n = 1 To i - 1
          NoCompare = (j = c(n))
          If NoCompare Then Exit For
        Next n
        If Not NoCompare Then
          For k = 1 To row
             For n = 1 To i - 1
               NoCompare = (k = r(n))
               If NoCompare Then Exit For
             Next n
             If Not NoCompare Then
               If Abs(m(k, j)) >= Pivot Then
                  Pivot = Abs(m(k, j))
                  r(i) = k: c(i) = j
               End If
             End If
          Next k
        End If
     Next j
     Pivot = m(r(i), c(i))
     If Pivot <> 1 Then
        For k = 1 To row
          m(r(i), k) = m(r(i), k) / Pivot
          ReturnValue(r(i), k) = ReturnValue(r(i), k) / Pivot
        Next k
     End If
     For j = 1 To row
        Pivot = m(j, c(i))
        If j <> r(i) And Pivot <> 0 Then
          For k = 1 To row
             m(j, k) = m(j, k) - m(r(i), k) * Pivot
             ReturnValue(j, k) = ReturnValue(j, k) - ReturnValue(r(i), k) * Pivot
          Next
        End If
     Next j
   Next i
   For i = 1 To row - 1
     If r(i) <> c(i) Then
        For j = 1 To row
          '測試m是否為單位矩陣之用
          'temp2(j) = m(r(i), j)
          'm(r(i), j) = m(c(i), j)
          'm(c(i), j) = temp2(j)
       
          temp(j) = ReturnValue(r(i), j)
          ReturnValue(r(i), j) = ReturnValue(c(i), j)
          ReturnValue(c(i), j) = temp(j)
        Next
        For j = i + 1 To row
          If r(j) = c(i) Then r(j) = r(i): Exit For
        Next
        r(i) = c(i)
     End If
   Next
End Sub
arrow
arrow
    全站熱搜

    vbqa 發表在 痞客邦 留言(1) 人氣()