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

Question

我对 vba 很陌生，但我现在确实有一些工作代码。我执行此代码，它会清除一张纸上的单元格，引用该纸上的装配号，在另一张纸中搜索该装配号，复制我想要与该装配号相关的数据，然后粘贴到原始纸上。

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

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

有没有一种快速的方法来更改“If Sheets("Stencils").Cells(i, 8).Value = assembly Then" 行，使其不需要精确值？

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

任君挑选……

Like Operator

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

模块级语句...

区分大小写

Option Compare Binary

不区分大小写

Option Compare Text

InStr

区分大小写

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

不区分大小写

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

Find method

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

Regex

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

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

Custom Character Analysis

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

这是一个例子，展示了如何制作一个像 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