Question

我想编写一个VBA函数，该函数将数组作为Excel工作表的输入，并将修改后的数组作为输出输出到同一工作表上的另一个范围。

我的数组通常有20个数字，并且在同一工作表上会有很多这样的调用。我尝试了一个带有2x3矩阵的简单示例，但失败了。将输入输入VBA可以正常工作，但是我无法将函数的输出放回Excel。使用独立的子例程，我不会遇到任何问题。

Option Explicit

Private Const nR As Long = 3
Private Const nC As Long = 2

Public MsgTxt As String
Public MsgTit As String
Public iMsg As Integer

Private ArrO(1 To nR, 1 To nC) As Variant

Function DoArrays(wrF As Range, wrT As Range) As Long
    Dim nRI As Long
    Dim nCI As Long
    Dim iR As Long
    Dim iC As Long
    Dim wc1 As Range
    Dim wcx As Range

    Dim ArrI() As Variant
    ArrI = wrF.Value

    nRI = wrF.Rows.Count
    If nRI <> nR Then
        MsgTit = "GetArray: misaligned rows"
        MsgTxt = "nRI = " & CStr(nRI)
        iMsg = MsgBox(MsgTxt, vbCritical, MsgTit)
        End
    End If

    nCI = wrF.Columns.Count
    If nCI <> nC Then
        MsgTit = "GetArray: misaligned columns"
        MsgTxt = "nCI = " & CStr(nCI)
        iMsg = MsgBox(MsgTxt, vbCritical, MsgTit)
        End
    End If

    For iR = 1 To nR
        For iC = 1 To nC
            ArrO(iC, iR) = -ArrI(iR, iC)
        Next iC
    Next iR

    Set wc1 = wrF.Cells(1, 1)
    Set wcx = wrF.Cells(nR, nC)

    MsgTit = "DoArrays"
    MsgTxt = ""
    MsgTxt = MsgTxt & vbCrLf & "Range wrF"
    MsgTxt = MsgTxt & vbCrLf & "# rows = " & CStr(nR)
    MsgTxt = MsgTxt & vbCrLf & "# cols = " & CStr(nC)
    MsgTxt = MsgTxt & vbCrLf & "address of first cell = " & wc1.Address
    MsgTxt = MsgTxt & vbCrLf & "address of last  cell = " & wcx.Address
    MsgTxt = MsgTxt & vbCrLf & "Array Arr"
    MsgTxt = MsgTxt & vbCrLf & " 1st index runs " & CStr(LBound(ArrI, 1)) & " to " & CStr(UBound(ArrI, 1))
    MsgTxt = MsgTxt & vbCrLf & " 2nd index runs " & CStr(LBound(ArrI, 2)) & " to " & CStr(UBound(ArrI, 2))
    iMsg = MsgBox(MsgTxt, vbInformation, MsgTit)

    Call PutArray(wrT)

    DoArrays = nR * nC
End Function

Sub PutArray(wrT As Range)
    Dim nRT As Long
    Dim nCT As Long

    nRT = wrT.Rows.Count
    If nRT <> nC Then
        MsgTit = "PutArray: misaligned rows"
        MsgTxt = "nRT = " & CStr(nRT)
        iMsg = MsgBox(MsgTxt, vbCritical, MsgTit)
        End
    End If

    nCT = wrT.Columns.Count
    If nCT <> nR Then
        MsgTit = "PutArray: misaligned columns"
        MsgTxt = "nCT = " & CStr(nCT)
        iMsg = MsgBox(MsgTxt, vbCritical, MsgTit)
        End
    End If

    MsgTit = "Range wrT in Putarray"
    MsgTxt = ""
    MsgTxt = MsgTxt & vbCrLf & "Range wrT"
    MsgTxt = MsgTxt & vbCrLf & "# rows = " & CStr(nR)
    MsgTxt = MsgTxt & vbCrLf & "# cols = " & CStr(nC)
    iMsg = MsgBox(MsgTxt, vbInformation, MsgTit)

    wrT.Value = ArrO
End Sub

Sub main2()
    Dim wr As Range
    Dim ws As Worksheet

    ArrO(1, 1) = 11
    ArrO(1, 2) = 21
    ArrO(1, 3) = 31
    ArrO(2, 1) = 12
    ArrO(2, 2) = 22
    ArrO(2, 3) = 32

    Set ws = ThisWorkbook.Worksheets("Sheet2")

    Set wr = ws.Range(ws.Cells(9, 2), ws.Cells(10, 4))

    Call PutArray(wr)
End Sub

函数DoArrays可以正常工作，直到子例程PutArray中的最后一个语句。失败，并返回#VALUE。如果从子Main2以“独立”方式调用该子例程，则PutArray可以正常工作。

我怀疑这里的问题是Excel检测循环引用的能力。但是必须有一个灵魂。内置函数MINV完全提供了我想要的功能。有没有办法结合VBA宏使用神奇的CSE击键（控制移位输入）？

用于Excel的VBA宏，具有一个数组作为输入，一个数组作为输出

0 个答案: