VBA复制粘贴stringsearch

我似乎无法弄清楚如何编写一个vba代码，通过search单元格C10：G10来查找等于单元格A10的匹配，一旦find，将范围A14：A18复制到匹配的单元格，但低于例如F14：F18（请参阅图片）

下面的macros

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

Answer 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来帮助您查找范围内的值。
然后返回与您的search条件匹配的Range对象。
为了使您的值到正确的位置，只需使用Offset and Resize Method 。

编辑1：回答OP的评论

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

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

以上代码查找与单元格A10具有完全相同公式的范围。

Answer 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 

Answer 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 

Answer 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