Укажите диапазон Excel по листам в VBA

Question

В VBA, почему следующие сбои?

Dim rng as Range rng = Range("Sheet1:Sheet3!A1")

Он бросает исключение HRESULT. Есть ли другой способ построить этот диапазон в VBA? Обратите внимание, что вы можете ввести функцию рабочего листа, например = SUM (Sheet1: Sheet3! A1), и она работает нормально.

Answer 1

A Диапазон объект ограничен только одним рабочим листом. В конце концов, он может иметь только одного родителя.

Функция = SUM() может работать с группой диапазонов. (это верно для многих функций рабочего листа)

EDIT # 1

Я искал решение, так как Janauary:

UDF Syntax

.

Я использую массив диапазонов. Не очень хорошее решение.

Answer 2

Просто развивается ответ Гэри (если вы собираетесь принять ответ, принять его :):

Range Использование переменной:

Sub SumTest1() 

    Dim rSheet1  As Range 
    Dim rSheet2  As Range 
    Dim rSheet3  As Range 
    Dim dSum  As Double 

    With ThisWorkbook 
     Set rSheet1 = .Sheets("Sheet1").Range("A1") 
     Set rSheet2 = .Sheets("Sheet2").Range("A1") 
     Set rSheet3 = .Sheets("Sheet3").Range("A1") 
    End With 

    dSum = WorksheetFunction.Sum(rSheet1, rSheet2, rSheet3) 
    Debug.Print CStr(dSum) 

End Sub 

Использование Variant переменной:

Sub SumTest2() 

    Dim vArray  As Variant 
    Dim dSum  As Double 

    With ThisWorkbook 
     vArray = Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1")) 
    End With 

    dSum = WorksheetFunction.Sum(vArray) 
    Debug.Print CStr(dSum) 

End Sub 

Использование без переменной:

Sub SumTest3() 

    Dim dSum  As Double 

    With ThisWorkbook 
     dSum = WorksheetFunction.Sum(Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1"))) 
    End With 

    Debug.Print CStr(dSum) 

End Sub 

Answer 3

непроверенная, но попробовать этот

Dim rng as string 
rng = "Sheet1:Sheet3!A1" 
worksheet("Sheet1").range("B1").formula = "=SUM(" & rng & ")" 

Answer 4

Вот набор UDF функций, которые выполняют по существу то же самое. Единственное ограничение в том, что ссылка на 3D-диапазона является строкой, т.е. "Jan:Dec!A1" в противоположность прямо Jan:Dec!A1

'Adapted from https://web-beta.archive.org/web/20060313132405/http://www.j-walk.com/ss/excel/eee/eee003.txt by Andre Terra 
Function CountIf3D(Range3D As String, Criteria As String, _ 
    Optional Count_Range As Variant) As Variant 

    Dim sTestRange As String 
    Dim sCountRange As String 
    Dim Sheet1 As Integer 
    Dim Sheet2 As Integer 
    Dim n As Integer 
    Dim Count As Double 

    Application.Volatile 

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _ 
     Range3D, Sheet1, Sheet2, sTestRange) = False Then 
     CountIf3D = CVErr(xlErrRef) 
    End If 

    If IsMissing(Count_Range) Then 
     sCountRange = sTestRange 
    Else 
     sCountRange = Count_Range.Address 
    End If 

    Count = 0 
    For n = Sheet1 To Sheet2 
     With Worksheets(n) 
     Count = Count + Application.WorksheetFunction.CountIf(.Range _ 
    (sTestRange), Criteria) 
     End With 
    Next n 
    CountIf3D = Count 
End Function 'CountIf3D 

Function SumIf3D(Range3D As String, Criteria As String, _ 
    Optional Sum_Range As Variant) As Variant 

    Dim sTestRange As String 
    Dim sSumRange As String 
    Dim Sheet1 As Integer 
    Dim Sheet2 As Integer 
    Dim n As Integer 
    Dim Sum As Double 

    Application.Volatile 

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _ 
     Range3D, Sheet1, Sheet2, sTestRange) = False Then 
     SumIf3D = CVErr(xlErrRef) 
    End If 

    If IsMissing(Sum_Range) Then 
     sSumRange = sTestRange 
    Else 
     sSumRange = Sum_Range.Address 
    End If 

    Sum = 0 
    For n = Sheet1 To Sheet2 
     With Worksheets(n) 
     Sum = Sum + Application.WorksheetFunction.SumIf(.Range _ 
    (sTestRange), Criteria, .Range(sSumRange)) 
     End With 
    Next n 
    SumIf3D = Sum 
End Function 'SumIf3D 

Function AverageIf3D(Range3D As String, Criteria As String, _ 
    Optional Average_Range As Variant) As Variant 

    Dim sTestRange As String 
    Dim sSumRange As String 
    Dim Sheet1 As Integer 
    Dim Sheet2 As Integer 
    Dim n As Integer 
    Dim Sum As Double 
    Dim Count As Double 

    Application.Volatile 

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _ 
     Range3D, Sheet1, Sheet2, sTestRange) = False Then 
     AverageIf3D = CVErr(xlErrRef) 
    End If 

    If IsMissing(Average_Range) Then 
     sSumRange = sTestRange 
    Else 
     sSumRange = Average_Range.Address 
    End If 

    Sum = 0 
    Count = 0 
    For n = Sheet1 To Sheet2 
     With Worksheets(n) 
     Sum = Sum + Application.WorksheetFunction.SumIf(.Range(sTestRange), Criteria, .Range(sSumRange)) 
     Count = Count + Application.WorksheetFunction.CountIf(.Range(sTestRange), Criteria) 
     End With 
    Next n 
    AverageIf3D = Sum/Count 
End Function 'SumIf3D 

Function Parse3DRange(sBook As String, SheetsAndRange _ 
    As String, FirstSheet As Integer, LastSheet As Integer, _ 
    sRange As String) As Boolean 

    Dim sTemp As String 
    Dim i As Integer 
    Dim Sheet1 As String 
    Dim Sheet2 As String 

    Parse3DRange = False 
    On Error GoTo Parse3DRangeError 

    sTemp = SheetsAndRange 
    i = InStr(sTemp, "!") 
    If i = 0 Then Exit Function 

    'next line will generate an error if range is invalid 
    'if it's OK, it will be converted to absolute form 
    sRange = Range(Mid$(sTemp, i + 1)).Address 

    sTemp = Left$(sTemp, i - 1) 
    i = InStr(sTemp, ":") 
    Sheet2 = Trim(Mid$(sTemp, i + 1)) 
    If i > 0 Then 
     Sheet1 = Trim(Left$(sTemp, i - 1)) 
    Else 
     Sheet1 = Sheet2 
    End If 

    'next lines will generate errors if sheet names are invalid 
    With Workbooks(sBook) 
    FirstSheet = .Worksheets(Sheet1).Index 
    LastSheet = .Worksheets(Sheet2).Index 

    'swap if out of order 
    If FirstSheet > LastSheet Then 
     i = FirstSheet 
     FirstSheet = LastSheet 
     LastSheet = i 
    End If 

    i = .Worksheets.Count 
    If FirstSheet >= 1 And LastSheet <= i Then 
     Parse3DRange = True 
    End If 
    End With 
Parse3DRangeError: 
    On Error GoTo 0 
    Exit Function 

End Function 'Parse3DRange