Ответьте на вопрос:
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