0

编辑:您可以在下面的“更正代码”下找到修改后的代码

我正在努力研究如何编写一个返回数组的 VBA 函数,其中数组的每个元素都是一个范围对象。理想情况下,我想知道如何编写,以便每个范围对象可以是不连续的单元格选择,在伪代码中,类似于:

MyReturnedArrayOfRangeObjects (1) = (A1:C3, A6, B4:B6)

我找到了这个线程: 在 VBA 中使用范围数组 - Excel 这让我很接近,但我在函数声明中一定做错了(我认为)。

一堆原始代码与问题无关,因此已将其删除,并且我制作了一个简单的示例,该示例将仅返回每个数组元素中的单个单元格。当我运行它时,下面的代码在该行返回一个 ByRef 类型不匹配:

Set FindLastContentCell(i) = LastCell

除了下面的代码之外,我还尝试使函数声明成为变体(没有变化)。如果我从上面显示的代码行中删除“Set”,我会得到一个“赋值左侧的函数调用必须返回 Variant 或 Object”:

    Function FindLastContentCell(Optional WB As Workbook = Nothing, Optional JustWS As Worksheet = Nothing) As Range()

    Dim myLastRow As Long, myLastCol As Long, i As Long
    Dim wks As Worksheet
    Dim dummyRng As Range, LastCell As Range
    Dim AnyMerged As Variant
    Dim Proceed As Boolean
    Dim iResponse As Integer

    ' Initialise variables
    Set LastCell = Nothing
    i = 0

    [Bunch of extra code removed]

    If JustWS Is Nothing Then
        If WB Is Nothing Then Set WB = ActiveWorkbook
        For Each wks In WB.Worksheets

            [Bunch of extra code removed]

            If Proceed Then
                With wks
                    myLastRow = 0
                    myLastCol = 0
                    Set dummyRng = .UsedRange
                    On Error Resume Next
                    myLastRow = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
                                searchdirection:=xlPrevious, SearchOrder:=xlByRows).row
                    myLastCol = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
                                searchdirection:=xlPrevious, SearchOrder:=xlByColumns).Column
                End With
                On Error GoTo 0
                Set LastCell = Cells(myLastRow, myLastCol)
                ReDim Preserve FindLastContentCell(0 To i)
                Set FindLastContentCell(i) = LastCell
                i = i + 1        
            End If
        Next wks
    End If

End Function

调用子是:

Sub temp()

Call FindLastContentCell

End Sub

更正的代码


Sub Temp()

Dim rng As Range, results() As Range
Dim x As Variant

results() = FindLastContentCell

End Sub

Function FindLastContentCell(Optional WB As Workbook = Nothing, Optional JustWS As Worksheet = Nothing) As Variant

    'Modded by me

    'From:
    ' http://www.contextures.com/xlfaqApp.html#Unused

    Dim myLastRow As Long, myLastCol As Long
    Dim i As Integer
    Dim wks As Worksheet
    Dim dummyRng As Range, LastCell As Range, LastCells() As Range
    Dim AnyMerged As Variant
    Dim Proceed As Boolean
    Dim iResponse As Integer

    ' Initialise variables
    Set LastCell = Nothing
    i = 0

    ' If the code is only to consider one worksheet passed as JustWS
    ' then determine if something was passed as JustWS
    If JustWS Is Nothing Then
        ' Nothing is found in JustWS, so code runs for each worksheet, either in the passed workbook
        ' object, or else for the ActiveWorkbook
        If WB Is Nothing Then Set WB = ActiveWorkbook
        For Each wks In WB.Worksheets
    ' This is where the code will run from if something was passed as JustWS, otherwise the line below
    ' has no impact on code execution
RunOnce:
            ' Check for merged cells
            AnyMerged = wks.UsedRange.MergeCells
            ' Responde accordingly and let user decide if neccessary
            If AnyMerged = False Then
                Proceed = True
            ElseIf AnyMerged = True Then
                MsgBox "The whole used range is merged. Nothing will be done on this worksheet"
                Proceed = False
            ElseIf IsNull(AnyMerged) Then
                iResponse = MsgBox("There are some merged cells on the worksheet." & vbNewLine & _
                                "This might cause a problem with the calculation of the last cells location." & vbNewLine & vbNewLine & _
                                "Do you want to proceed anyway?", _
                                vbYesNo, _
                                "Calculate Last Cell")
                If iResponse = vbYes Then
                    Proceed = True
                Else
                    Proceed = False
                End If
            Else
                MsgBox "If you this, an error has occured in FindLastContentCell." & vbNewLine & _
                        "Code execution has been stopped."
                Stop
            End If

            If Proceed Then
                With wks
                    myLastRow = 0
                    myLastCol = 0
                    Set dummyRng = .UsedRange
                    On Error Resume Next
                    myLastRow = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
                                searchdirection:=xlPrevious, SearchOrder:=xlByRows).row
                    myLastCol = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
                                searchdirection:=xlPrevious, SearchOrder:=xlByColumns).Column
                End With
                On Error GoTo 0
                Set LastCell = Cells(myLastRow, myLastCol)

                ReDim Preserve LastCells(i)
                Set LastCells(i) = LastCell
                i = i + 1

                ' * This is where code will exit if only a single worksheet is passed.
                ' * Exits if a worksheet object was passed as JustWS, rather than looping through each worksheet
                ' in the workbook variable that was either passed, or which defaults to ActiveWorkbook
                If Not JustWS Is Nothing Then
                    FindLastContentCell = LastCells
                    Exit Function
                End If

            End If
        Next wks
    ' If a worksheet was passed as JustWS
    Else
        GoTo RunJustOneWS
    End If

    FindLastContentCell = LastCells

    ' Exit upon completion of a workbook variable any code
    ' below here is only run if a worksheet is passed as JustWS
    Exit Function

    ' Setup to run the single worksheet that was passed as JustWS
RunJustOneWS:
        Set wks = JustWS
        GoTo RunOnce

End Function
4

2 回答 2

0

从您所说的来看,您似乎对VBAArrays并没有太清楚的想法。Ranges在这里,您有一个示例代码可以稍微澄清这两个问题:

Function getRandomRanges() As Range()

    Dim totRanges As Integer: totRanges = 3
    ReDim outRanges(totRanges - 1) As Range

    Set outRanges(0) = Range("A1")
    Set outRanges(1) = Range("B2:C10")
    Set outRanges(2) = Cells(2, 3)

    getRandomRanges = outRanges

End Function

您可以通过执行以下操作调用此函数:

Dim retrievedRanges() As Range
retrievedRanges = getRandomRanges

您可以retrievedRanges以不同的方式使用;例如:

   retrievedRanges(0).Value = "value I want to write in the A1 range"
于 2013-09-02T10:57:09.867 回答
0

我不确定您要实现什么目标,但据我所知,您正在尝试使用工作簿的每个工作表的最后一个单元格构建范围数组。

我的建议是创建一个范围的临时数组并用你想要的范围对象填充它,最后返回这个临时数组。现在我看到“varocarbas”的先前答案只是暗示了同样的想法

Function FindLastContentCell(Optional xlsWb As Workbook = Nothing, Optional xlsWs As Worksheet = Nothing) As Range()

    Dim myLastRow As Long, myLastCol As Long
    Dim wks As Worksheet
    Dim lastCell As Range
    Dim arrayTmp() As Range
    Dim index As Integer

    [Bunch of extra code removed]

    If xlsWb Is Nothing then
        Set xlsWb = ActiveWorkbook
    End if
    Redim arrayTemp (wks.Worksheets.Count) As Range
    For Each wks in xlsWb.Worksheets
        myLastRow = wks.UsedRange.Rows.Count
        myLastColumn = wks.UsedRange.Columns.Count
        Set lastCell = wks.Cells(myLastRow,myLastColumn)
        Set arrayTemp(index) = lastCell
        index = index + 1
    Next
    Set FindLastContentCell = arrayTemp

End Function
于 2013-09-02T11:29:42.040 回答