VBA 复制粘贴字符串搜索答案

【问题标题】：VBA Copy Paste string searchVBA 复制粘贴字符串搜索
【发布时间】：2015-07-17 02:31:45
【问题描述】：

我似乎无法弄清楚如何编写一个通过单元格 C10:G10 搜索的 vba 代码以找到等于单元格 A10 的匹配项，一旦找到，将范围 A14:A18 复制到匹配的单元格但低于例如 F14： F18（见图）

下面的宏

'Copy
Range("A14:A18").Select
Selection.Copy
'Paste
Range("F14:F18").Select
ActiveSheet.Paste!

【问题讨论】：

标签： vba excel

【解决方案1】：

试试这个：

With Sheets("SheetName") ' Change to your actual sheet name
    Dim r As Range: Set r = .Range("C10:G10").Find(.Range("A10").Value2, , , xlWhole)
    If Not r Is Nothing Then r.Offset(4, 0).Resize(5).Value2 = .Range("A14:A18").Value2
End With

范围对象有Find Method 可帮助您查找范围内的值。
然后返回与您的搜索条件匹配的 Range 对象。
要将您的值放到正确的位置，只需使用Offset and Resize Method。

Edit1：回答OP的评论

要在 Ranges 中查找公式，您需要将 LookIn 参数设置为 xlFormulas。

Set r = .Range("C10:G10").Find(What:=.Range("A10").Formula, _
                               LookIn:=xlFormulas, _
                               LookAt:=xlWhole)

以上代码找到与单元格 A10 公式完全相同的 Ranges。

【讨论】：

L42 - 如果查找和搜索值是公式，我如何让它工作？ ..我尝试更改 .Value2 但似乎不起作用。

【解决方案2】：

Dim RangeToSearch As Range
Dim ValueToSearch
Dim RangeToCopy As Range
Set RangeToSearch = ActiveSheet.Range("C10:G10")
Set RangeToCopy = ActiveSheet.Range("A14:A18")

ValueToSearch = ActiveSheet.Cells(10, "A").Value
For Each cell In RangeToSearch
    If cell.Value = ValueToSearch Then
        RangeToCopy.Select
        Selection.Copy
        Range(ActiveSheet.Cells(14, cell.Column), _
            ActiveSheet.Cells(18, cell.Column)).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Exit For
    End If
Next cell

【讨论】：

避免使用select 方法，这是不好的做法

【解决方案3】：

其他变种

1.使用For each循环

Sub test()
Dim Cl As Range, x&

For Each Cl In [C10:G10]
    If Cl.Value = [A10].Value Then
        x = Cl.Column: Exit For
    End If
Next Cl

If x = 0 Then
    MsgBox "'" & [A10].Value & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

Range(Cells(14, x), Cells(18, x)).Value = [A14:A18].Value

End Sub

2.使用Find方法（L42已经发过，但有点不同）

Sub test2()
Dim Cl As Range, x&

On Error Resume Next

x = [C10:G10].Find([A10].Value2, , , xlWhole).Column

If Err.Number > 0 Then
    MsgBox "'" & [A10].Value2 & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

[A14:A18].Copy Range(Cells(14, x), Cells(18, x))

End Sub

3.使用WorksheetFunction.Match

Sub test2()
Dim Cl As Range, x&

On Error Resume Next

x = WorksheetFunction.Match([A10], [C10:G10], 0) + 2

If Err.Number > 0 Then
    MsgBox "'" & [A10].Value2 & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

[A14:A18].Copy Range(Cells(14, x), Cells(18, x))

End Sub

【讨论】：

【解决方案4】：

给你，

    Sub DoIt()
    Dim rng As Range, f As Range
    Dim Fr As Range, Crng As Range

    Set Fr = Range("A10")
    Set Crng = Range("A14:A18")
    Set rng = Range("C10:G19")
    Set f = rng.Find(what:=Fr, lookat:=xlWhole)

    If Not f Is Nothing Then
        Crng.Copy Cells(14, f.Column)
    Else: MsgBox "Not Found"
        Exit Sub
    End If
End Sub

【讨论】：