編集: 改訂されたコードは、以下の「修正されたコード」の下にあります。
配列の各要素が範囲オブジェクトである配列を返す VBA 関数を作成する方法を考え出すのに苦労しています。理想的には、次のような疑似コードで、各範囲オブジェクトがセルの不連続な選択になるように記述する方法を知りたいと思います。
MyReturnedArrayOfRangeObjects (1) = (A1:C3, A6, B4:B6)
このスレッドを見つけました: Using an Array of Ranges in VBA - Excel これは私に近づきますが、関数宣言で何か間違ったことをしているに違いありません (私は思う)。
元のコードの束は質問とは無関係だったので、削除して、各配列要素で 1 つのセルだけを返す簡単な例を作成しました。これを実行すると、以下のコードは行で ByRef 型の不一致を返します。
Set FindLastContentCell(i) = LastCell
以下のコードとは別に、関数宣言をバリアント (変更なし) にしてみました。上記のコード行から「Set」を削除すると、「割り当ての左側の関数呼び出しはバリアントまたはオブジェクトを返す必要があります」というメッセージが表示されます。
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