编辑:您可以在下面的“更正代码”下找到修改后的代码
我正在努力研究如何编写一个返回数组的 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