Excel VBA查找单元格的一部分

我想要创build一个Excel VBAmacros，寻找“a123Apple873hhh”，并知道我只是想寻找“苹果”。

在一个例子上更容易理解：

在sheet1上，我有我的固定表格数组和名称及其代码：

Column A---Column B 12------ --Banana 20-------- Apple 44-------- Orange 

在sheet2上，我有我想要的东西：

 Column A----------Column B .......... -------ds$$Orange1111aaa .......... -------22Apple999 .......... -------22Watermelon .......... -------9q9Orange7ab etc... 

我想要一个看起来在sheet2 / Column B上的VBA，findSheet1 / Column B上的名字，并在sheet2 / Column A上给出它的代码。所以最终的结果是：

 Column A------Column B 44 -----------ds$$Orange1111aaa 20 -----------22Apple999 *BLANK* ------22Watermelon 44 -----------9q9Orange7ab etc... 

我的代码不工作，因为它只是find确切的结果：

 Sub FindCode() Const COLUMN As String = "E" Dim i As Long Dim iLastRow As Long Dim cell As Range Dim sh As Worksheet With ActiveSheet iLastRow = .Cells(.Rows.Count, COLUMN).End(xlUp).Row For i = 6 To iLastRow If .Cells(i, "E") = "" Then .Cells(i, "A").Value = "" Else .Cells(i, "A").Value = Application.VLookup(.Cells(i, "E").Value, Range("etc!A:B"), 2, False) End If Next i End With End Sub 

Answer 1

这个代码不是非常灵活，并且有一些游戏突破的局限性，但是它确实做了你所要求的。

我使用了与您提供的完全相同的数据。 Sheet1看起来像这样：

Sheet2如下所示：

我用这个代码

 Sub SearchProduct() Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets(1) Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(2) Dim fruit As Range: Set fruit = ws1.Range("B2", ws1.Cells(ws1.Rows.Count, "B").End(xlUp)) Dim fruitCode As Range: Set fruitCode = ws2.Range("B2", ws2.Cells(ws2.Rows.Count, "B").End(xlUp)) Dim f As Range, s As Range For Each s In fruit For Each f In fruitCode If InStr(s.Text, f.Text) <> 0 Then s.Offset(0, -1).Value = f.Offset(0, -1).Value GoTo SkipTheRest End If Next f SkipTheRest: Next s End Sub 

在Sheet2上产生了以下结果

---

其中一些限制如下：

1. 如果你有青苹果之类的东西，就不会因为太空而find价值。 这可以很容易地通过使用Replace()来修复。
2. 如果你有西瓜这样的东西，还有另外一个东西是瓜，那么这个东西就会给这两个瓜ID号。 一些fancier编码（实际上有点）将需要避免这一点。
3. 还有一些其他问题可能会出现，具体取决于您使用的值，但大部分是对代码的小编辑。 以上两个问题（即2.）将是相当难以避免..

Answer 2

这应该做的：

 Option Explicit Sub main() Dim fruitRng As Range, cell As Range, found As Range Dim firstAddress As String With Worksheets("Sheet1") Set fruitRng = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants) End With With Worksheets("Sheet2") With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants) For Each cell In fruitRng Set found = .Find(what:=WorksheetFunction.Trim(cell.Value), lookat:=xlPart, LookIn:=xlValues) If Not found Is Nothing Then firstAddress = found.Address Do found.Offset(, -1).Value = cell.Offset(, -1).Value Set found = .FindNext(found) Loop While found.Address <> firstAddress End If Next cell .Offset(, -1).SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents End With End With End Sub