如果每个单元格有多个项目，则搜索单个项目

Question

我是vba的新手，但我现在确实有一些可以工作的代码。我执行此代码，它清除一个工作表上的单元格，引用该工作表上的装配号，在另一个工作表中搜索该装配号，复制与该装配号相关的数据，然后粘贴到原始工作表中。

当电子表格数据库中的每个单元格恰好有一个程序集编号时，这适用于感兴趣的程序集编号。但是，如果程序集编号与单元格的精确值不匹配(如果每个单元格有多个程序集就会发生这种情况)，则代码会向上传递该单元格，并且不会粘贴相关数据。

有没有办法在单元格中查找，并让宏来识别程序集号是否在单元格内的程序集号数组中？

有没有一种快速的方法来改变"If Sheets("Stencils").Cells(i，8).Value = assembly“行，这样它就不需要精确的值了？

Sub findstencil()
    '1. declare variables
    '2. clear old search results
    '3. find records that match search criteria and paste them

    Dim assembly As String 'Assembly number of interest, containts numbers, letters and dashes
    Dim finalrow As Integer 'determines last row in database
    Dim i As Integer 'row counter

    'clears destination cells
    Sheets("Search").Range("A7:H15").ClearContents

    assembly = Sheets("Search").Range("A5").Value
    finalrow = Sheets("Stencils").Range("C5000").End(xlUp).Row

    For i = 5 To finalrow
        If Sheets("Stencils").Cells(i, 8).Value = assembly Then
            Sheets("Stencils").Cells(i, 3).Resize(1, 6).Copy
            Sheets("Search").Range("B15").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i

    Sheets("Search").Range("A5").Select
End Sub

Answer 1

随便你选吧。

If Cells(i, 3).Value Like "*" & AssemblyNumber & "*" Then

模块级语句...

区分大小写

Option Compare Binary

不区分大小写

Option Compare Text

区分大小写

If InStr(1, Cells(i, 3).Value2, AssemblyNumber, 0) > 0 Then

不区分大小写

If InStr(1, Cells(i, 3).Value2, AssemblyNumber, 1) > 0 Then

Set SearchRange = Range(Cells(5, 3), Cells(finalrow, 3))
Set cl = SearchRange.Find( _
    What:=AssemblyNumber, _
    After:=SearchRange.Cells(1, 1), _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
If Not cl Is Nothing Then
    Sheets("Stencils").Cells(cl.Row, 3).Resize(1, 6).Copy
    Sheets("Search").Range("B15").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If

当它变得非常复杂时使用正则表达式

How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops

如果您愿意，您甚至可以逐个字符进行比较。我以前做过这样做，以实现统计并找到近似/最佳猜测匹配。

这里有一个例子，展示了如何制作一个像InStr这样的函数，它允许匹配中的容差……

Function InStrTolerant(InputString As String, MatchString As String, Optional CaseInsensitiveChoice = False, Optional Tolerance As Integer = 0) As Integer
'Similar to InStr, but allows for a tolerance in matching


Dim ApxStr As String 'Approximate String to Construct
Dim j As Integer 'Match string index
j = 1
Dim Strikes As Integer
Dim FoundIdx As Integer

For i = 1 To Len(InputString)

    'We can exit early if a match has been found
    If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
        InStrTolerant = FoundIdx
        Exit Function
    End If

    If StringsMatch(Mid(InputString, i, 1), Mid(MatchString, j, 1), CaseInsensitiveChoice) Then
        'This character matches, continue constructing
        ApxStr = ApxStr + Mid(InputString, i, 1)
        j = j + 1
        FoundIdx = i
    Else
        'This character doesn't match
        'Substitute with matching value and continue constructing
        ApxStr = ApxStr + Mid(MatchString, j, 1)
        j = j + 1
        'Since it didn't match, take a strike
        Strikes = Strikes + 1
    End If

    If Strikes > Tolerance Then
        'Strikes exceed tolerance, reset contruction
        ApxStr = ""
        j = 1
        Strikes = 0
        i = i - Tolerance
    End If
Next

If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
    InStrTolerant = FoundIdx
Else
    InStrTolerant = 0
End If

End Function