时间戳

首页 > 解决方案 > VBA在范围内查找一个单词并复制以相同单词开头的所有单元格

excel - VBA在范围内查找一个单词并复制以相同单词开头的所有单元格

问题描述

我的日常工作需要帮助。我有一行（2），其中有许多填充的单元格。在一个实例中，我有几个（数字不时变化）单元格连续以单词 Blue 开头（并以数字 1、2、3 4 等结尾）。忽略数字，我想复制所有以 Blue* 开头的单元格（作为范围？）。我设法使用以下代码找到并复制了一个单元格：

Sub findcopy()
  Dim rFound As Range
  
  Set rFound = Sheets("page 1").Rows(2).Find(What:="Blue", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not rFound Is Nothing Then rFound.Offset(0, 0).Resize(1).Copy Destination:=Sheets("page 1").Range("AG2")

End Sub

谢谢

标签： excelvba

解决方案

我想这应该可以完成这项工作。我会尝试对其进行更多改进，但目前这是可行的。不过，在接受我自己的答案之前，我会欢迎其他答案（如果更好，也可以接受）和建议。谢谢

Sub SearchX()
Dim c, destination As Range, i As Long
Const SEARCH_TERM As String = "Blue"
Set destination = ActiveSheet.Range("AA10")
For Each c In ActiveSheet.Range("B2:BB2")
i = 1
Do While InStr(i, c.Value, SEARCH_TERM) > 0
destination.Value = c.Value
Set destination = destination.Offset(1, 0)
i = InStr(i, c.Value, SEARCH_TERM) + Len(SEARCH_TERM)
Loop
Next
End Sub

推荐阅读