Использовать возвращенный диапазон из функции - PullRequest
0 голосов
/ 26 февраля 2019

Ответьте на вопрос:

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

У меня есть подпункт (ниже), предназначенный для копирования строкданные из исходного листа (результаты выполнения) до целевого листа (ошибка) на основе значений в столбце F (имя заголовка - тип ошибки).Идея состоит в том, что если столбец F содержит какие-либо значения, найденные в моем массиве myFType, то вся строка должна быть скопирована на целевой лист.

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

И это подводит меня к моему запросу - Как я могу переписать строку этого: Range("E3:E" & lngLastRow & i) к этому: Range(find_Header("Failure Type", "Copy") & i) или даже к этому Range(find_Header("Failure Type", "Copy"))

Потому что, как это, я возвращаюдиапазон (или я так думаю) от моей функции, но из того, что я могу сказать, это не правильно.

Запись строки следующим образом: Range(find_Header("Failure Type", "Copy") & i) выдаёт мне ошибку, но запись так: Range(find_Header("Failure Type", "Copy").Address & i) не.

НО, когда я смотрю на «диапазон», он показывает мне нелепый диапазон, например, + -8000 строк, и у меня есть только 85 строк данных ... Так что это заставляет меня думать, что это работает неправильно.Уловка в том, что если я выберу найденный диапазон, он выберет правильное количество строк (85).

Вся эта работа с диапазонами ДЕЙСТВИТЕЛЬНО сбивает меня с толку, и все, что я пытаюсь достичь, это скопировать строку, найдязаголовок и на основе значений в столбце под этим заголовком.

В подпункте ниже я прокомментировал два раздела, в которых мне необходимо «использовать» диапазон, который я возвращаю из своей функции.

Вот подпункт:

Sub Copy()

    Dim xRg As Range
    Dim xCell As Range
    Dim i As Long, J As Long, K As Long, x As Long, count As Long
    Dim y As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim element As Variant, myFType As Variant, myEnv As Variant, myDefects As Variant

    myFType = Array("F1", "F2", "F3")
    myEnv = Array("Env1", "Env2")
    myDefects = Array("New", "Existing")

    Set y = Workbooks("Template.xlsm")

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

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

    count = 3

    If J = 1 Then

        If Application.WorksheetFunction.CountA(Worksheets("Failed").UsedRange) = 0 Then J = 0

    End If

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

    '************ 

    'This is where I would like to call the function to get the range
    'I want to change the line from: 
    'Range("E3:E" & lngLastRow & i) --> Range(find_Header("Failure Type", "Copy") & i)

    '************ 

    Set xRg = Worksheets("Run Results").Range("E3:E" & lngLastRow & i)

    'On Error Resume Next
    Application.ScreenUpdating = False

    For Each element In myFType

        For K = 1 To xRg.count

            If CStr(xRg(K).Value) = element Then

                myLRow = ws2.Cells(Rows.count, "B").End(xlUp).Row + 1
                xRg(K).EntireRow.Copy Destination:=ws2.Range("A" & myLRow)

                J = J + 1

            End If

        Next

        ws2.Activate

        With ws2

            '************ 

            'This is where I would like to call the function to get the range
            'I want to change the line from: 
            'Range("E" & Rows.count) --> Range(find_Header("Failure Type", "Copy") & Rows.count)
            'AND
            'Range("E3:E" & x) --> Range(find_Header("Failure Type", "Copy") & x)

            '************ 

            x = Range("E" & Rows.count).End(xlUp).Row

            Range("K" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)

            count = count + 1

        End With

    Next element

    count = 8

    count = 12

    ws2.Columns("B:K").AutoFit

    Application.ScreenUpdating = True

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

    Dim y As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set y = Workbooks("Template.xlsm")

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

    With ws1

        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

            MsgBox "Column Not Found"

        End If

    End With

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...