Как скопировать диапазон во временную рабочую книгу и вернуть ссылку на нее с помощью функции vba?

Question

У меня есть следующие ошибки в строке «rTemp.Value = vaTemp». Что я здесь не так делаю? Я на правильном пути?

Function CreateTempRange(rSource As range) As range
    ' Declarations
    Dim rTemp As range
    Dim vaTemp As Variant
    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    ' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    ' Copy range into it and get a reference to the temp range
    vaTemp = rSource.Value
    Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))
    rTemp.Value = vaTemp

    ' Return the temp range
    Set CreateTempRange = rTemp
End Function

Примечание. Эта функция предназначена для использования другими функциями и не вызывается непосредственно из ячейки.

Answer 1

vaTemp = rSource.Value

Поскольку вы не указываете параметр RangeValueDataType для метода Value объекта Range, по умолчанию он будет равен xlRangeValueDefault, который для непустых диапазонов будет возвращать массив значений. Следовательно, части UBound(..., 1) и UBound(..., 2) имеют смысл.

Это было бы проще:

Function CreateTempRange(rSource As range) As range
    ' Declarations
    Dim rTemp As range
    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    ' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    ' Create new range on that sheet starting at cell A1
    Set rTemp = wsTemp.Range(Cells(1, 1), Cells(rSource.Rows.Count, _
        rSource.Columns.Count))
    rTemp.Value = rSource.Value

    ' Return the temp range
    Set CreateTempRange = rTemp
End Function

Вам все еще понадобится некоторый код для работы с диапазонами, которые состоят из нескольких областей (используйте для проверки свойство Areas.Count)

Answer 2

Я бы сделал это так

Function CreateTempRange(src As Range) As Range

Dim wbk As Workbook: Set wbk = Workbooks.Add
Dim sht As Worksheet: Set sht = wbk.Worksheets.Add

Call src.Copy(sht.Cells(1, 1))

Set CreateTempRange = Range(rSource.Address).Offset(1 - rSource.Row, 1 - rSource.Column)

End Function

Объяснение последней строки кода (по запросу): -

Range(rSource.Address) - это относится к диапазону на текущем листе (содержащем код) с тем же локальным адресом, что и диапазон источника, поэтому, если диапазон источника C3: E5 на «Листе X», то Range(rSource.Address) относится к C3: E5 на текущем листе.

Поскольку мы вставили скопированный диапазон в текущий лист, начиная с ячейки A1, а не с ячейки C3 (я полагаю, это ваше требование), нам необходимо соответствующим образом сместить эту ссылку. .Offset(1 - rSource.Row, 1 - rSource.Column) отрицательно смещает этот диапазон как индексом строки (3) минус 1, так и индексом столбца (C или 3) минус 1 исходного диапазона, так что окончательная результирующая ссылка начинается с ячейки A1 и сохраняет те же измерения, что и диапазон источника.

Надеюсь, это поможет.

Answer 3

Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2)

Здесь будет несоответствие типов ... Я не уверен, что это действительно имеет какой-то смысл. ubound (a, 2) используется для многомерных массивов без диапазонов.

Я предполагаю, что вы хотите взять значение в указанной ячейке, а затем скопировать его много раз в зависимости от его значения. Это верно?

Надеюсь, ниже приведен пример для работы. Если не редактировать свой пост, я посмотрю, смогу ли я помочь.

Function CreateTempRange(rSource As Range) As Range
    '' Declarations
    Dim rTemp As Range
    Dim vaTemp As Variant

    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    '' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    '' Copy range into it and get a reference to the temp range
    vaTemp = rSource.Value
    ''Set rTemp = wsTemp.Range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))

    Dim iTemp As Integer
    On Error Resume Next
    iTemp = CInt(vaTemp)
    On Error GoTo 0

    If iTemp < 1 Then
      iTemp = 1
    End If
    Set rTemp = wsTemp.Range("A1:A" & iTemp)
    rTemp.Value = vaTemp

    '' Return the temp range
    Set CreateTempRange = rTemp
End Function

Sub test()

  Dim r As Range
  Dim x As Range
  Set r = ActiveSheet.Range("A1")
  Set x = CreateTempRange(r)

End Sub

Answer 4

Деано, этот код работает для меня как написано. Какую ошибку вы получаете?