VBA - Использование текущего выбора в качестве объекта диапазона

Question

У меня есть эта функция ниже, которая выполняет следующие действия:

1. Принимает два параметра (имя заголовка, необходимая функция).
2. Параметр имени заголовка используется для поиска заголовка ивпоследствии для определения диапазона этого столбца вплоть до последней строки.
3. Параметр Function Needed используется для переключения в операторе select для любых дополнительных необходимых шагов.
4. В конце большинствая делаю Range.Select, затем выхожу из функции с выбранным диапазоном.

Вот код:

Function find_Header(header As String, fType As String)
    Dim aCell As Range, rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String

    With ActiveSheet
        Set aCell = .Range("B2:J2").Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

        'If Found
        If Not aCell Is Nothing Then
            col = aCell.Column
            colName = Split(.Cells(, col).Address, "$")(1)

            lRow = Range(colName & .Rows.count).End(xlUp).Row + 1

            Set myCol = Range(colName & "2")

            Select Case fType
                Case "Copy"
                    'This is your range
                    Set rng = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)

                    rng.Select
            End Select

        'If not found
        Else
            MsgBox "Column Not Found"
        End If
    End With

End Function

Поскольку я пытаюсь очистить мойкод, я наткнулся на раздел, где у меня есть конкретно жестко закодированные диапазоны, и я вместо этого пытаюсь использовать свою функцию, однако сейчас я нахожусь в такой ситуации, когда я не могу правильно использовать эту функцию, поскольку я не могу "передать диапазон обратно к сабвуферу, и я не могу сделать выбор объекта диапазона, необходимого для сабвуфера.

Вот что находится в сабвуфере:

Sub Copy_Failed()
    Dim xRg As Range, xCell As Range
    Dim i As Long, J As Long, count As Long
    Dim fType As String, colName As String
    Dim y As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    myarray = Array("Defect", "System", "Script")
    myEnv = Array("SIT", "UAT")
    myDefects = Array("New", "Existing")

    i = Worksheets("Run Results").UsedRange.Rows.count
    J = Worksheets("Failed").UsedRange.Rows.count

    Set y = Workbooks("Template.xlsm")

    Set ws1 = y.Sheets("Failed")
    Set ws2 = y.Sheets("Run Results")

    count = 3

    If J = 1 Then

        If Application.WorksheetFunction.CountA(ws1.UsedRange) = 0 Then J = 0

    End If

    ws2.Activate

    fType = "Copy"
    colName = "Status"

    Call find_Header(colName, fType)
End Sub

До того, как я использовалфункция, код выглядел так:

lngLastRow = Cells(Rows.count, "B").End(xlUp).Row

Set xRg = ws2.Range("E3:E" & lngLastRow & i)

Теперь эти 2 строки выполняются в функции, поэтому она мне не нужна в подпрограмме.Я пробовал следующее:

Set rngMyRange = Selection

Set rngMyRange = ActiveSheet.Range(Selection.Address)

Set xRg = ws2.Range(rngMyRange  & i)

Но я получаю ошибку:

Несоответствие типов

Итак, я думаю это:

1. Выберите диапазон в функции, затем используйте его в подчиненном элементе - но как?
2. Выясните, как передать фактический объект диапазона из моей функции в подчиненный элемент

Хотя второй вариант потребует некоторых дополнительных изменений в моем коде, я думаю, что это лучший вариант.

Answer 1

Хорошо, вот иллюстрация, чтобы вы могли понять, что я имею в виду.Если вы поместите «один» где-нибудь в B2: J2, он выберет диапазон.Я только использую Select здесь, чтобы вы могли видеть диапазон, который он определяет.(Отказ от ответственности: я не до конца понимаю, что вы делаете, и не уверен, что вам нужен весь этот код для достижения того, что вы хотите.)

Функция теперь возвращает переменную диапазона и присваивается r,Запустите процедуру x.

Sub x()

Dim r As Range

Set r = Range("a1", find_Header("one", "Copy"))
r.Select

End Sub

---

Function find_Header(header As String, fType As String) As Range

Dim aCell As Range, rng As Range
Dim col As Long, lRow As Long
Dim colName As String

With ActiveSheet
    Set aCell = .Range("B2:J2").Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    'If Found
    If Not aCell Is Nothing Then
        col = aCell.Column
        colName = Split(.Cells(, col).Address, "$")(1)
        lRow = Range(colName & .Rows.Count).End(xlUp).Row + 1
        Set myCol = Range(colName & "2")
        Select Case fType
            Case "Copy"
                'This is your range
                Set find_Header = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)
            End Select
    'If not found
    Else
        Set find_Header = Nothing
    End If

End With

End Function