关注此问题
VBA - Using Current Selection As Range Object
我有一个子目录（以下），用于根据以下内容将数据行从源表（运行结果）复制到目标表（失败） 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中，我已经注释了两个部分，需要“利用”从函数返回的范围。
这是子目录：
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