【问题标题】:Why is my VBA Code for the RREF of a matrix in Excel not working?为什么我的 Excel 中矩阵 RREF 的 VBA 代码不起作用?
【发布时间】:2023-02-11 01:54:30
【问题描述】:
Function ReduceToRREF(matrixRange As Range) As Variant
    Dim matrix As Variant
    Dim rowCount As Long
    Dim colCount As Long
    Dim lead As Long
    Dim r As Long
    Dim c As Long
    Dim i As Long
    Dim multiplier As Double

    matrix = matrixRange.Value
    rowCount = UBound(matrix, 1)
    colCount = UBound(matrix, 2)
    lead = 1
    

    For r = 1 To rowCount
        If colCount < lead Then Exit For
        i = r
        While matrix(i, lead) = 0
            i = i + 1
            If rowCount < i Then
                i = r
                lead = lead + 1
                If colCount < lead Then Exit For
            End If
        Wend
        If i <> r Then
            For c = lead To colCount
                matrix(r, c) = matrix(r, c) + matrix(i, c)
            Next c
        End If
        multiplier = matrix(r, lead)
        For c = lead To colCount
            matrix(r, c) = matrix(r, c) / multiplier
        Next c
        For i = 1 To rowCount
            If i <> r Then
                multiplier = matrix(i, lead)
                For c = lead To colCount
                    matrix(i, c) = matrix(i, c) - multiplier * matrix(r, c)
                Next c
            End If
        Next i
        lead = lead + 1
    Next r

    ReduceToRREF = matrix
End Function


我认为这是一个很好的解决方案,而且在大多数情况下它似乎都能正常工作。但是,我遇到了一个失败的例子:

这:

返回这个:

什么时候应该返回这个:

关于可能出问题的任何想法?

我还尝试仅采用矩阵前三行的 RREF,并且按预期工作。这是怎么回事?

【问题讨论】:

  • 如果您编辑问题并尝试解释用文字你尝试完成什么,我的意思是要应用的算法,你可能会得到一些帮助。否则,很难猜测一个运行不佳的代码必须做什么来对抗它......
  • 你真的需要帮助吗?

标签: excel vba linear-algebra


【解决方案1】:

减少的行阶梯形式

链接

  • 我找到this PDF 解释它是什么,我想尽可能简单。
  • Here 是维基百科对它的看法。

关于

  • 您在两个方面都是对的:您的函数产生了错误的结果,而您提供了正确的结果。
  • 不幸的是,我从未听说过它,但我研究了一段时间并弄清楚了它是如何工作的(手动)。
  • 我不知道您的函数是否正确或是否有足够的知识来找出它的问题所在。
  • 我简单的对数据进行了排序,这是允许的,得到了​​正确的结果。因此,我编写了一个过程,以便您可以在从范围中获得矩阵后立即对其进行排序。
  • 该过程使用冒泡排序算法(最简单但最慢)对数据进行排序上升从上到下和“从左到右”,后者意味着如果第一列中的值相等,则下一列中较小的值将确定两列中最上面的值。
  • 顺便说一句,降序排列的数据也获得了正确的结果。
  • 由您来测试它,因此感谢您的反馈。

修复!?

  • 在您的函数中,在线下方

    matrix = matrixRange.Value
    

    添加行

    SortData matrix
    

    它使用以下过程。

排序程序

Sub SortData(ByRef Data As Variant)
    
    Dim LB1 As Long, UB1 As Long: LB1 = LBound(Data, 1): UB1 = UBound(Data, 1)
    Dim LB2 As Long, UB2 As Long: LB2 = LBound(Data, 2): UB2 = UBound(Data, 2)
    
    Dim pVal, nVal, tVal, i As Long, j As Long, c As Long, IsSwappy As Boolean
    
    For i = LB1 To UB1 - 1
        For j = i + 1 To UB1
            pVal = Data(i, LB2)
            nVal = Data(j, LB2)
            Select Case pVal
                Case nVal
                    For c = LB2 + 1 To UB2
                        Select Case Data(i, c)
                            Case Is > Data(j, c): IsSwappy = True: Exit For
                            Case Is < Data(j, c): Exit For
                        End Select
                    Next c
                Case Is > nVal: IsSwappy = True
            End Select
            If IsSwappy Then
                For c = LB2 To UB2
                    tVal = Data(i, c)
                    Data(i, c) = Data(j, c)
                    Data(j, c) = tVal
                Next c
                IsSwappy = False
            End If
        Next j
    Next i
            
End Sub

排序过程的测试

Sub SortDataTEST()
    Dim Data(): Data = Sheet1.Range("A1").CurrentRegion
    PrintData Data, , , "Initial"
    SortData Data
    PrintData Data, , , "Sorted"
End Sub
  • 为了不使 SO 与现有代码混淆,请从 here 复制 PrintData 过程。

我的测试程序

Sub ReduceToRREFtest()

    Dim Data()

    With Sheet1.Range("A1").CurrentRegion
        Data = ReduceToRREF(.Cells)
    End With
    
    With Sheet2.Range("A1").Resize(UBound(Data, 1), UBound(Data, 2))
        .Value = Data
    End With

End Sub

【讨论】:

    猜你喜欢
    • 2021-01-12
    • 1970-01-01
    • 1970-01-01
    • 2012-02-27
    • 2014-01-23
    • 2013-08-06
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多