Excel VBA到单元格的vlookup部分

Question

I want to create a Excel VBA macro that looks for "a123Apple873hhh" and knows that I just wanted to look for "Apple".

It's easier to understand on an example:

On sheet1 I have my fixed table array with a name and its code:

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

On sheet2 I have what I want to look for:

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

I want a VBA that looks on sheet2/Column B, finds what name is on sheet1/Column B and give its code on sheet2/Column A. So, the final result is:

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

My code don't work because it just find exact results:

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

This code isn't very flexible, and has some game breaking limitations, but it does do what you're asking.

I used the exact same data you provided. Sheet1 look like this:

Sheet2 is as follows:

I used this code

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

Which yielded the following result on Sheet2

---

Some of the limitations are as follows:

1. If you have something like Green Apple, it won't find the value because of the Space. This can be easily fixed by using Replace() .
2. If you have something like Watermelon, and another item as Melon, it's going to give the Melon ID # to both. Some fancier coding (a bit of it actually) would be needed to avoid this.
3. There's a few other issues that may come up depending on the values you're using but they are for the most part small edits to the code. The above two issues (namely 2.) is going to be pretty difficult to avoid..

Answer 2

this should do:

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