编辑：您可以在下面的“更正代码”下找到修改后的代码
我正在努力研究如何编写将返回数组的VBA函数，其中数组的每个元素都是一个范围对象。理想情况下，我想知道如何编写，以便每个范围对象可以是伪代码中不连续的单元格选择，如下所示：
MyReturnedArrayOfRangeObjects（1）=（A1：C3，A6，B4：B6）
我找到了这个帖子： Using an Array of Ranges in 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
答案 0 :(得分：0)
根据您的说法，您似乎对VBA中的Arrays和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"
答案 1 :(得分：0)
我不确定您要实现的目标，但据我所知，您正在尝试使用工作簿的每个工作表的最后一个单元格构建Ranges数组。
我的建议是创建一个范围的临时数组，并用你想要的Range对象填充它，最后返回这个临时数组。现在我看到之前的“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