输入矩阵_编程黑洞网

由于VBA中缺少适当的Matrix数据结构，我经常感到沮丧。多维数组显然是处理它的正确方法，但是有很多缺失……例如，您不能本地检查数组是否已确定尺寸，在保存时无法调整数组的大小值，除了最后一个维，没有方便的VBA语法用于将立即值加载到数组等。

所以我创建了一个Matrix类，该类支持：

矩阵运算-Add，Subtract，Multiply，ScalarMultiply，Augment，Transpose

基本行运算SwapRows，ScaleRow，AddScalarMultipleRow
用于从字符串中加载矩阵的解析器-LoadMatrixString
>实用程序功能-ToString和Clone
高斯消除的实现-RowReduce

解析器是基于本教程手工编写的递归下降解析器。

基本行操作具有破坏性，因为否则会降低性能。

矩阵操作具有非破坏性，因为它们使用结果并返回。这允许方法链接，例如Set D = A.Multiply(B).Add(C).ScalarMultiply(5)，以及直观的行为，例如C = A x B以及A和B本身在此过程中不会被修改。我很想使这些方法具有破坏性，以提高性能（为每个中间矩阵操作创建一个对象），但是我不确定A.Multiply(B)的结果将是A多么直观。

我在这里发布了该课程的早期版本作为对问题的答案，但此后做了一些改进。那里的测试代码仍然有效。

我特别想知道是应该将解析器拆分为一个单独的类以独立使用，还是由Matrix类本身调用。我已经尝试清理代码命名约定-子/函数使用PascalCase，变量名称使用camelCase并删除匈牙利语-但是如果我错过了一些内容，请向我指出。我一直在读，除非您专门针对性能进行编码，否则从代码可维护性的角度出发，最好在类中尽可能地调用访问器，而不是总是直接修改私有成员，因为如果访问器的实现发生变化，您就不会然后必须遍历其余代码并更改其他功能中的处理方式-听起来正确吗？

这是非常完备的Matrix类：

Option Compare Database
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

'----------------------------------
'This array holds the values of the Matrix
Private matrixArray() As Double

'----------------------------------
'Shared recursive descent parsing variables
Private tempMatrixString As String
Private look As String

Public Sub Class_Initialize()

End Sub

'************************************************
'* Accessors and Utility Functions *
'***********************************

Public Property Get Value(r As Long, c As Long) As Double

    CheckDimensions

    Value = matrixArray(r, c)
End Property

Public Property Let Value(r As Long, c As Long, val As Double)

    CheckDimensions

    matrixArray(r, c) = val
End Property

Public Property Get Rows() As Long
    If GetDims(matrixArray) = 0 Then
        Rows = 0
    Else
        Rows = UBound(matrixArray, 1) + 1
    End If
End Property

Public Property Get Cols() As Long
    If GetDims(matrixArray) = 0 Then
        Cols = 0
    Else
        Cols = UBound(matrixArray, 2) + 1
    End If
End Property

Public Sub LoadMatrixString(str As String)
    tempMatrixString = str
    ParseMatrix str
    tempMatrixString = ""
    look = ""
End Sub

Public Sub Resize(Rows As Long, Cols As Long, Optional blPreserve As Boolean = False)
    Dim tempMatrix As Matrix
    Dim r As Long
    Dim c As Long

    If blPreserve Then

        CheckDimensions

        Set tempMatrix = Me.Clone
        ReDim matrixArray(0 To Rows - 1, 0 To Cols - 1)
        For r = 0 To MinLongs(tempMatrix.Rows, Me.Rows) - 1
            For c = 0 To MinLongs(tempMatrix.Cols, Me.Cols) - 1
                Value(r, c) = tempMatrix.Value(r, c)
            Next
        Next
    Else
        ReDim matrixArray(0 To Rows - 1, 0 To Cols - 1)
    End If

End Sub

Public Function Clone() As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    Set mresult = New Matrix
    mresult.Resize Me.Rows, Me.Cols
    For r = 0 To Me.Rows - 1
        For c = 0 To Me.Cols - 1
            mresult.Value(r, c) = Me.Value(r, c)
        Next
    Next
    Set Clone = mresult
End Function

Public Function ToString() As String
    Dim str As String
    Dim r As Long
    Dim c As Long
    Dim tempRow() As String
    Dim tempRows() As String
    ReDim tempRow(0 To Me.Cols - 1)
    ReDim tempRows(0 To Me.Rows - 1)


    If Not GetDims(matrixArray) = 0 Then 'Need to check if array is empty
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                tempRow(c) = Me.Value(r, c)
            Next
            tempRows(r) = "[" & Join(tempRow, ", ") & "]"
        Next
        ToString = "[" & Join(tempRows, vbCrLf) & "]"
    Else
        ToString = ""
    End If
End Function

'***********************************************************
'* Matrix Operations *
'*********************

Public Function Add(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    If m.Rows = Me.Rows And m.Cols = Me.Cols Then
        Set mresult = New Matrix
        mresult.Resize Me.Rows, Me.Cols
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
            Next
        Next
    Else
        Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
    End If
    Set Add = mresult
End Function

Public Function Subtract(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    If m.Rows = Me.Rows And m.Cols = Me.Cols Then
        Set mresult = New Matrix
        mresult.Resize Me.Rows, Me.Cols
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                mresult.Value(r, c) = Me.Value(r, c) - m.Value(r, c)
            Next
        Next
    Else
        Err.Raise vbObjectError + 2, "Matrix.Subtract", "Could not Subtract matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
    End If
    Set Subtract = mresult
End Function

Public Function Multiply(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim i As Long
    Dim j As Long
    Dim n As Long

    CheckDimensions

    If Me.Cols = m.Rows Then
        Set mresult = New Matrix
        mresult.Resize Me.Rows, m.Cols
        For i = 0 To Me.Rows - 1
            For j = 0 To m.Cols - 1
                For n = 0 To Me.Cols - 1
                    mresult.Value(i, j) = mresult.Value(i, j) + (Me.Value(i, n) * m.Value(n, j))
                Next
            Next
        Next
    Else
        Err.Raise vbObjectError + 3, "Matrix.Multiply", "Could not Subtract matrices: the Columns of the left matrix and Rows of the right must be the same. The left matrix has " & Me.Cols & " Columns and the right matrix has " & m.Rows & " Rows."
    End If

    Set Multiply = mresult

End Function

Public Function ScalarMultiply(scalar As Double) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    Set mresult = New Matrix
    mresult.Resize Me.Rows, Me.Cols
    For r = 0 To Me.Rows - 1
        For c = 0 To Me.Cols - 1
            mresult.Value(r, c) = Me.Value(r, c) * scalar
        Next
    Next

    Set ScalarMultiply = mresult

End Function

Public Function Augment(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions


    If Me.Rows = m.Rows Then
        Set mresult = New Matrix
        mresult.Resize Me.Rows, Me.Cols + m.Cols
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                mresult.Value(r, c) = Me.Value(r, c)
            Next
        Next

        For r = 0 To Me.Rows - 1
            For c = 0 To m.Cols - 1
                mresult.Value(r, Me.Cols + c) = m.Value(r, c)
            Next
        Next
    Else
        Err.Raise vbObjectError + 4, "Matrix.Augment", "Could not Augment matrices: the matrices must have the same number of Rows. The left matrix has " & Me.Rows & " Rows and the right matrix has " & m.Rows & " Rows."
    End If
    Set Augment = mresult
End Function

Public Function Transpose() As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    If Me.Rows = Me.Cols Then
        Set mresult = New Matrix
        mresult.Resize Me.Cols, Me.Rows
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                Me.Value(r, c) = mresult(c, r)
            Next
        Next
    Else
        Err.Raise vbObjectError + 5, "Matrix.Augment", "Could not Transpose matrix: the matrix must have the same number of Rows and Cols. The matrix is (" & Me.Rows & ", " & Me.Cols & ")."
    End If
    Set Transpose = mresult
End Function

Public Function RowReduce() As Matrix
    Dim i As Long
    Dim j As Long

    CheckDimensions

    'Row Echelon
    Dim mresult As Matrix
    Set mresult = Me.Clone

    For i = 0 To mresult.Rows - 1
        If Not mresult.Value(i, i) <> 0 Then
            For j = i + 1 To mresult.Rows - 1
                If mresult.Value(j, i) > 0 Then
                    mresult.SwapRows i, j
                    Exit For
                End If
            Next
        End If

        If mresult.Value(i, i) = 0 Then
            Exit For
        End If

        mresult.ScaleRow i, 1 / mresult.Value(i, i)

        For j = i + 1 To mresult.Rows - 1
            mresult.AddScalarMultipleRow i, j, -mresult.Value(j, i)
        Next
    Next

    'Backwards substitution

    For i = IIf(mresult.Rows < mresult.Cols, mresult.Rows, mresult.Cols) - 1 To 1 Step -1
        If mresult.Value(i, i) > 0 Then
            For j = i - 1 To 0 Step -1
                mresult.AddScalarMultipleRow i, j, -mresult.Value(j, i)
            Next
        End If
    Next

    Set RowReduce = mresult
End Function


'*************************************************************
'* Elementary Row Operaions *
'****************************

Public Sub SwapRows(r1 As Long, r2 As Long)
    Dim temp As Double
    Dim c As Long

    CheckDimensions

    For c = 0 To Me.Cols - 1
        temp = Me.Value(r1, c)
        Me.Value(r1, c) = Me.Value(r2, c)
        Me.Value(r2, c) = temp
    Next
End Sub

Public Sub ScaleRow(row As Long, scalar As Double)
    Dim c As Long

    CheckDimensions

    For c = 0 To Me.Cols - 1
        Me.Value(row, c) = Me.Value(row, c) * scalar
    Next
End Sub

Public Sub AddScalarMultipleRow(srcrow As Long, destrow As Long, scalar As Double)
    Dim c As Long

    CheckDimensions

    For c = 0 To Me.Cols - 1
        Me.Value(destrow, c) = Me.Value(destrow, c) + (Me.Value(srcrow, c) * scalar)
    Next
End Sub

'************************************************************
'* Parsing Functions *
'*********************

Private Sub ParseMatrix(strMatrix As String)
    Dim arr() As Double
    Dim c As Long
    GetChar 1
    Match "["
    SkipWhite
    If look = "[" Then
        arr = ParseRow
        Me.Resize 1, UBound(arr) + 1
        'ReDim matrixArray(0 To UBound(arr), 0 To 0)
        For c = 0 To Me.Cols - 1
            Me.Value(0, c) = arr(c)
        Next
        SkipWhite
        While look = ","
            Match ","
            SkipWhite
            arr = ParseRow
            Me.Resize Me.Rows + 1, Me.Cols, True

            If UBound(arr) <> (Me.Cols - 1) Then
                'Error jagged array
                Err.Raise vbObjectError + 6, "Matrix.LoadMatrixString", "Parser Error - Jagged arrays are not supported: Row 0 has " & Me.Cols & " Cols, but Row " & Me.Rows - 1 & " has " & UBound(arr) + 1 & " Cols."
            End If
            For c = 0 To Me.Cols - 1
                Me.Value(Me.Rows - 1, c) = arr(c)
            Next
            SkipWhite
        Wend
        Match "]"
    ElseIf look = "]" Then
        Match "]"
    Else
        MsgBox "Error"
    End If
    SkipWhite
    If look <> "" Then
        Err.Raise vbObjectError + 7, "Matrix.LoadMatrixString", "Parser Error - Unexpected Character: """ & look & """."
    End If
End Sub

Private Function ParseRow() As Variant
    Dim arr() As Double
    Match "["
    SkipWhite
    ReDim arr(0 To 0)
    arr(0) = ParseNumber
    SkipWhite
    While look = ","
        Match ","
        ReDim Preserve arr(0 To UBound(arr) + 1)
        arr(UBound(arr)) = ParseNumber
        SkipWhite
    Wend
    Match "]"
    ParseRow = arr
End Function

Private Function ParseNumber() As Double
    Dim strToken As String
    If look = "-" Then
        strToken = strToken & look
        GetChar
    End If
    While IsDigit(look)
        strToken = strToken & look
        GetChar
    Wend
    If look = "." Then
        strToken = strToken & look
        GetChar
        While IsDigit(look)
            strToken = strToken & look
            GetChar
        Wend
    End If

    ParseNumber = CDbl(strToken)
End Function

'****************************************************************

Private Sub GetChar(Optional InitValue)
    Static i As Long
    If Not IsMissing(InitValue) Then
        i = InitValue
    End If
    If i <= Len(tempMatrixString) Then
        look = Mid(tempMatrixString, i, 1)
        i = i + 1
    Else
        look = ""
    End If
End Sub

'****************************************************************
'* Skip Functions (Parser) *
'***************************

Private Sub SkipWhite()
    While IsWhite(look) Or IsEOL(look)
        GetChar
    Wend
End Sub

'****************************************************************
'* Match/Expect Functions (Parser) *
'***********************************

Private Sub Match(char As String)
    If look <> char Then
        Expected """" & char & """"
    Else
        GetChar
        SkipWhite
    End If
    Exit Sub

End Sub

Private Sub Expected(str As String)
    'MsgBox "Expected: " & str
    Err.Raise vbObjectError + 8, "Matrix.LoadMatrixString", "Parser Error - Expected: " & str
End Sub

'****************************************************************
'* Character Class Functions (Parser) *
'**************************************

Private Function IsDigit(char As String) As Boolean

    Dim charval As Integer
    If char <> "" Then
        charval = Asc(char)
        If 48 <= charval And charval <= 57 Then
            IsDigit = True
        Else
            IsDigit = False
        End If
    Else
        IsDigit = False
    End If

End Function

Private Function IsWhite(char As String) As Boolean

    Dim charval As Integer
    If char <> "" Then
        charval = Asc(char)
        If charval = 9 Or charval = 11 Or charval = 12 Or charval = 32 Or charval = 160 Then '160 because MS Exchange sucks
            IsWhite = True
        Else
            IsWhite = False
        End If
    Else
        IsWhite = False
    End If

End Function

Private Function IsEOL(char As String) As Boolean
    If char = Chr(13) Or char = Chr(10) Then
        IsEOL = True
    Else
        IsEOL = False
    End If
End Function

'*****************************************************************
'* Helper Functions *
'********************

Private Sub CheckDimensions()
    If GetDims(matrixArray) = 0 Then
        'Error, uninitialized array
        Err.Raise vbObjectError + 1, "Matrix", "Array has not been initialized"
    End If
End Sub

Private Function GetDims(VarSafeArray As Variant) As Integer
    Dim lpSAFEARRAY As Long
    Dim lppSAFEARRAY As Long
    Dim arrayDims As Integer

    'This check ensures that the value inside the Variant is actually an array of some type
    If (VarType(VarSafeArray) And vbArray) > 0 Then

        'If the Variant contains an array, the pointer to the pointer to the array is located at VarPtr(VarSafeArray) + 8...
        CopyMemory VarPtr(lppSAFEARRAY), VarPtr(VarSafeArray) + 8, 4&
        '...and now dereference the pointer to pointer to get the actual pointer to the array...
        CopyMemory VarPtr(lpSAFEARRAY), lppSAFEARRAY, 4&
        '...which will be 0 if the array hasn't been initialized
        If Not lpSAFEARRAY = 0 Then
            'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
            CopyMemory VarPtr(arrayDims), lpSAFEARRAY, 2&
            GetDims = arrayDims
        Else
            GetDims = 0 'Array not initialized
        End If
    Else
        GetDims = 0 'It's not an array... Type mismatch maybe?
    End If
End Function

Private Function MinLongs(a As Long, b As Long) As Long
    If a < b Then
        MinLongs = a
    Else
        MinLongs = b
    End If
End Function

这是几个使用示例：

Option Compare Database

Public Sub TestMatrix()

    Dim m1 As Matrix
    Set m1 = New Matrix
    m1.LoadMatrixString ("[[ 0,  1,  4, 9, 16]," & _
                         " [16, 15, 12, 7,  0]," & _
                         " [ 1,  1,  1, 1,  1]]")

    Dim m2 As Matrix
    Set m2 = New Matrix
    m2.LoadMatrixString ("[[190]," & _
                         " [190]," & _
                         " [ 20]]")


    MsgBox m1.Augment(m2).RowReduce.ToString

End Sub

Public Sub TestMatrix2()
    'This is an example iteration of a matrix Petri Net as described here:
    'http://www.techfak.uni-bielefeld.de/~mchen/BioPNML/Intro/MRPN.html
    Dim D_Minus As Matrix
    Dim D_Plus As Matrix
    Dim D As Matrix

    Set D_Minus = New Matrix
    D_Minus.LoadMatrixString "[[0, 0, 0, 0, 1]," & _
                             " [1, 0, 0, 0, 0]," & _
                             " [0, 1, 0, 0, 0]," & _
                             " [0, 0, 1, 1, 0]]"

    Set D_Plus = New Matrix
    D_Plus.LoadMatrixString "[[1, 1, 0, 0, 0]," & _
                            " [0, 0, 1, 1, 0]," & _
                            " [0, 0, 0, 1, 0]," & _
                            " [0, 0, 0, 0, 1]]"


    Set D = D_Plus.Subtract(D_Minus)

    MsgBox D.ToString

    Dim Transition_Matrix As Matrix
    Dim Marking_Matrix As Matrix
    Dim Next_Marking As Matrix

    Set Transition_Matrix = New Matrix
    Transition_Matrix.LoadMatrixString "[[0, 1, 1, 0]]"

    Set Marking_Matrix = New Matrix
    Marking_Matrix.LoadMatrixString "[[2, 1, 0, 0, 0]]"

    Set Next_Marking = Transition_Matrix.Multiply(D).Add(Marking_Matrix)

    MsgBox Next_Marking.ToString

End Sub

我一定会留意的！

我认为这段代码中有一个错误；我认为Value被设计为默认属性，这意味着它需要Attribute Value.VB_UserMemId = 0标签。我之所以这样说是因为Transpose之类的方法调用了Me.Value（r，c）= mresult（c，r）之类的东西，该方法目前无法正常工作，需要用Me.Value（r，c）= mresult.Value代替。（c，r）如果未添加标签。顺便说一句，该方法实际上应该是mresult.Value（c，r）= Me.Value（r，c）我认为，并且它不需要检查匹配的尺寸（Me.Rows = Me.Cols）转置非平方矩阵

您可以用“选项比较文本”替换“选项比较数据库”，以允许代码也可以在Excel中使用。

#1 楼

Public Sub Class_Initialize()

End Sub

避免空成员；尽管可以推断出r和c是为row和column设计的，但为清晰起见，这些单字母参数可能应该称为row和column。同样，Cols可能应该称为Columns。

这很不幸：调用属性ValueAt，然后可以将val参数称为value-由于默认情况下传递了ByRef参数，因此我明确指出了要传递它们ByVal-无需通过引用传递它们：

Public Property Let Value(r As Long, c As Long, val As Double)

对于LoadMatrixString，我考虑从此更改签名：

Public Property Let ValueAt(ByVal rowIndex As Long, ByVal columnIndex As Long, ByVal value As Double)

为此：

Public Sub LoadMatrixString(str As String)

对于带有m As Matrix参数的成员，我会选择ByVal value As Matrix并避免使用单字母标识符。我发现在这些情况下，“值”仍然是最具描述性的名称。

命名“维度”的方式存在不一致之处：您拥有CheckDimensions，但是您也拥有GetDims-我会重命名后一个GetDimensions。

我喜欢该类是独立的，但是在我看来，ToString实现将是使用您出色的StringBuilder类的完美借口，并且我敢打赌，您会更快地得到字符串输出；）

至此：

我特别想知道是否应该拆分将解析器分解为一个单独的类，以供单独使用，或者由Matrix类本身调用。

我认为您可以简单地将解析代码移至MatrixParser类，并完成它！ ...实际上，我将在其中复制LoadMatrixString过程，并将其重命名为Parse，将其命名为Function，并使其返回Matrix。然后可以修改LoadMatrixString以调用此新功能。

\ $ \ begingroup \ $
在VBA中使用行和列作为关键字时，是否会引起任何问题？
\ $ \ endgroup \ $
– enderland
2014-10-25 15:07

\ $ \ begingroup \ $
@enderland不是关键字-它们只是Worksheet和Range类的成员-不会阻止您拥有自己的;）
\ $ \ endgroup \ $
–马修·金登（Mathieu Guindon）♦
14-10-25在16:02

#2 楼

这绝不是完整的评论，但是我确实注意到了一些事情。如果您正在争取可维护的代码，则引发错误的方式可能会花费一些工作。

   Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."

因此，首先，我喜欢您将vbObjectError正确添加到了错误编号。我不喜欢的是是否要添加一个新错误，我必须手动查看整个文件以查看是否正在重用一个文件。这是Enum的绝佳用法。

Public Enum MatrixError
    AdditionError = vbObjectError + 1
    SomeOtherError
    ' ...
End Enum

好处有两个。

添加和使用错误号变得更加容易。
错误号会显示在客户端代码中，因此，如果出现错误，我可以检查Err.Number并进行适当处理。

类似的东西：

ErrHandler:
    If Err.Number = AdditionError Then
        ' do something to handle the matrix error
    Else
        ' throw it upstream
        Err.Raise Err.Number
    End If
End Sub

#3 楼

仅需考虑几件事，而不是代码，更多地是关于Matrix类的设计和使用。

在我特定而又特殊的宇宙角落，我们经常需要空矩阵，即是一个一维或零维为零的矩阵。这样的想法是，在程序执行过程中以及在一个或另一个时间点建立或破坏一个矩阵，使行为零是很自然的。准许的VBA不支持空数组，我已经解决的一种讨厌（或愚蠢）的方法是填充一个额外的行或列元素。当然，这是一些额外的空间，但这毕竟是2015年。

脚踏实地，我会使用无解析器的模拟物和LoadMatrixString的伴侣，例如

Public Sub LoadMatrixVector(rows as Long, columns as Long, values() as Double)

可能与辅助功能（如

Public Function Vector(ParamArray values() As Variant) As Double()
    Dim result() As Double
    ReDim result(UBound(values))
    Dim i As Long
    Dim item As Variant
    i = 0
    For Each item In values
        result(i) = CDbl(values(i))
        i = i + 1
    Next item
    Vector = result
End Function

结合使用，我可以在其中写

Set mat = LoadMatrixVector(3, 3, Vector(1, 2, 3))

/>
并得到具有三行1、2和3的矩阵。LoadMatrixVector可以根据需要包装值，直到填充结果为止。
此外，我可以将这样的事情视为可以接受的折衷方案进行适当的操作（您称其为“破坏性”）。

Set D = A.ShallowCopy().Multiply(B).Add(C).ScalarMultiply(5)

还有更多。我的建议可能会违反既定的编码惯例。我尝试兼顾简洁和清晰。

首先，我更喜欢在程序的早期处理简单的案例，以减少以后的（循环度量？）复杂性。例如，我会把一致性检查提早一点，甚至可能提早退出，而不是

Public Function Add(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    If m.Rows = Me.Rows And m.Cols = Me.Cols Then
        Set mresult = New Matrix
        mresult.Resize Me.Rows, Me.Cols
        For r = 0 To Me.Rows - 1
            For c = 0 To Me.Cols - 1
                mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
            Next
        Next
    Else
        Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
    End If
    Set Add = mresult
End Function

。并不是很短，但是函数的实际业务部分更简单并且缩进更少。

Public Function Add(m As Matrix) As Matrix
    Dim mresult As Matrix
    Dim r As Long
    Dim c As Long

    CheckDimensions

    If m.Rows <> Me.Rows Or m.Cols <> Me.Cols Then
        Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
    End If

    Set mresult = New Matrix
    mresult.Resize Me.Rows, Me.Cols
    For r = 0 To Me.Rows - 1
        For c = 0 To Me.Cols - 1
            mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
        Next
    Next
    Set Add = mresult
End Function

接下来，返回布尔结果的函数，例如

Private Function IsEOL(char As String) As Boolean
    If char = Chr(13) Or char = Chr(10) Then
        IsEOL = True
    Else
        IsEOL = False
    End If
End Function

可以这样写

Private Function IsEOL(char As String) As Boolean
    IsEOL = char = Chr(13) Or char = Chr(10)
End Function

尽管VBA在分配和相等性方面都使用=的设计决策在这里很烦人。

将这两个想法结合起来，isDigit可以变得更小

没错，您在做的事情上做得最好。

需要注释时，您才能解释自己在做什么，但否则您将假设自己的语言素养水平合理。

MultiplyScalar函数是一个不做太多事的好例子。
而不是因为VBA缺乏函数重载而不是试图在Multiply函数中分离标量和矩阵情况，而是将类型检查的重担留在了VBA所属的地方。

好东西。 >

#4 楼

使用Like可以使isDigit更快（或更短）两倍：

Private Function IsDigit(char As String) As Boolean

    IsDigit = char Like "[0-9]"

End Function