使用查找功能粘贴找到的整行
Using Find functions to paste the found Entire Row
我正在尝试使用 Find 函数查找 Sheet 2 中活动单元格的值（我强制活动单元格在 A 列中 selected，所以如果我 select "B4", 活动单元格为 "A4").
我希望 Find 函数从 Sheet 2 中找到“A”活动单元格的值并在 Sheet 1 中找到它，然后粘贴从 [=33= 中找到的行的整行] 1 进入 Sheet 2.
的第 2 行
分解：
- 在 Sheet 1
中的 A 列内找到 Sheet 2 列“A”活动单元格的值
- 将整行复制到Sheet2中找到的列A的第2行sheet1
我收到以下错误：
Run-time error 1004: "Method 'Range' of object '_Worksheet' Failedhttps://docs.microsoft.com/en-us/office/vba/api/overview/language-reference
我尝试使用多种组合来做到这一点，这里是我尝试的快照：
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
下面是完整的代码，在注释代码 Testing below 和 Testing Above 之间是我尝试的地方：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Row > 2 Then 'Doesn't Allow the "Titles" in Row 1 to be highlighted or changed
Application.EnableEvents = False
'ActiveWorkbook.Names.Add Name:="MyRange", RefersToR1C1:=Range("A" & (ActiveCell.Row)) 'Defines the name of the ActiveCell as "MyRange" to Autofill VLookup Formula on sheet
Range("A" & (ActiveCell.Row)).Select 'Always Selects Column A depending on the Active Row selecte
ActiveSheet.UsedRange.Offset(1).EntireRow.Interior.ColorIndex = 0 'Clears the previous Active Row's interior colour (yellow)
Target.EntireRow.Interior.Color = RGB(243, 243, 123) 'Sets the current Active Row's interior colour (as yellow)
'Testing below
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Testing above
If Target.Address = "$A" Then 'Checks if you have selected Row 2 (The comparison row)
Target.Value = "" 'If Cell A2 is selected (the "Key" comparison cell from the comparison row) then a blank value is inputted
Else 'If Cell A2 is not selected
[a2] = ActiveCell 'Makes cell "A2" equal to the Active Cell value (The "Key" in this case)
End If 'End IF statement
Me.Range("B2:CK2").Interior.Color = xlNone 'Clears any previous (if any) colouring inside cells
Dim rng As Range 'Declares variable as a range to store values
For Each rng In Me.Range("D2:CK2") 'Declares which columns to highlight yellow if there are any parameters in Sheet 2 that vary from Sheet 1
If IsNumeric(rng.Value) And IsNumeric(Me.Cells(Target.Row, rng.Column)) Then '[Exludes the Key, Date, Time & Part columns: hence starting at Column D for highlighting variances]
If rng.Value <> Me.Cells(Target.Row, rng.Column).Value Then 'Checks if the parameters vary from the main Database ("HE 171")
rng.Interior.Color = vbYellow 'Highlights any varying parameters in Yellow
End If 'End the first IF statement
End If 'End the second IF statement
Next 'Compares the next parameter until it reaches the last parameter
End If 'End the initial IF statement at the beginning of the macro
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
这至少有两个原因：
Sheet2.Range("ActiveCell") 只有在 Sheet2.ActiveCell 的范围时才有效
- 如果
.Find 失败（即如果它没有找到有问题的值），那么这将引发错误。
修复：
- 改为
Sheet2.Range("A" & ActiveCell.Row)。
- 测试
Find 是否成功，然后再执行其他操作，如下所示：
Dim foundRange as Range
Set foundRange = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole)
If Not foundRange is Nothing Then
Sheet2.Range("A2").EntireRow.Value = foundRange.EntireRow.Value
End If
我正在尝试使用 Find 函数查找 Sheet 2 中活动单元格的值（我强制活动单元格在 A 列中 selected，所以如果我 select "B4", 活动单元格为 "A4"). 我希望 Find 函数从 Sheet 2 中找到“A”活动单元格的值并在 Sheet 1 中找到它，然后粘贴从 [=33= 中找到的行的整行] 1 进入 Sheet 2.
的第 2 行分解：
- 在 Sheet 1 中的 A 列内找到 Sheet 2 列“A”活动单元格的值
- 将整行复制到Sheet2中找到的列A的第2行sheet1
我收到以下错误：
Run-time error 1004: "Method 'Range' of object '_Worksheet' Failedhttps://docs.microsoft.com/en-us/office/vba/api/overview/language-reference
我尝试使用多种组合来做到这一点，这里是我尝试的快照：
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
下面是完整的代码，在注释代码 Testing below 和 Testing Above 之间是我尝试的地方：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Row > 2 Then 'Doesn't Allow the "Titles" in Row 1 to be highlighted or changed
Application.EnableEvents = False
'ActiveWorkbook.Names.Add Name:="MyRange", RefersToR1C1:=Range("A" & (ActiveCell.Row)) 'Defines the name of the ActiveCell as "MyRange" to Autofill VLookup Formula on sheet
Range("A" & (ActiveCell.Row)).Select 'Always Selects Column A depending on the Active Row selecte
ActiveSheet.UsedRange.Offset(1).EntireRow.Interior.ColorIndex = 0 'Clears the previous Active Row's interior colour (yellow)
Target.EntireRow.Interior.Color = RGB(243, 243, 123) 'Sets the current Active Row's interior colour (as yellow)
'Testing below
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Testing above
If Target.Address = "$A" Then 'Checks if you have selected Row 2 (The comparison row)
Target.Value = "" 'If Cell A2 is selected (the "Key" comparison cell from the comparison row) then a blank value is inputted
Else 'If Cell A2 is not selected
[a2] = ActiveCell 'Makes cell "A2" equal to the Active Cell value (The "Key" in this case)
End If 'End IF statement
Me.Range("B2:CK2").Interior.Color = xlNone 'Clears any previous (if any) colouring inside cells
Dim rng As Range 'Declares variable as a range to store values
For Each rng In Me.Range("D2:CK2") 'Declares which columns to highlight yellow if there are any parameters in Sheet 2 that vary from Sheet 1
If IsNumeric(rng.Value) And IsNumeric(Me.Cells(Target.Row, rng.Column)) Then '[Exludes the Key, Date, Time & Part columns: hence starting at Column D for highlighting variances]
If rng.Value <> Me.Cells(Target.Row, rng.Column).Value Then 'Checks if the parameters vary from the main Database ("HE 171")
rng.Interior.Color = vbYellow 'Highlights any varying parameters in Yellow
End If 'End the first IF statement
End If 'End the second IF statement
Next 'Compares the next parameter until it reaches the last parameter
End If 'End the initial IF statement at the beginning of the macro
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
这至少有两个原因：
Sheet2.Range("ActiveCell")只有在Sheet2. 上有一个名为 - 如果
.Find失败（即如果它没有找到有问题的值），那么这将引发错误。
ActiveCell 的范围时才有效
修复：
- 改为
Sheet2.Range("A" & ActiveCell.Row)。 - 测试
Find是否成功，然后再执行其他操作，如下所示：
Dim foundRange as Range
Set foundRange = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole)
If Not foundRange is Nothing Then
Sheet2.Range("A2").EntireRow.Value = foundRange.EntireRow.Value
End If