Question

我对vba很新，但我现在确实有一些工作代码。我执行此代码并清除单张纸上的单元格，引用该纸张上的程序集编号，在另一张纸上搜索该程序集编号，复制我想要与该程序集编号相关的数据，然后粘贴到原始纸张上。 / p>

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

是否有某种方法可以在单元格中查看并让宏识别程序集编号是否在单元格中的程序集编号数组中？

是否有快速方法可以更改＆＃34;如果表格（＆＃34;模板＆＃34;）。单元格（i，8）.Value = assembly Then＆＃34;行，以便它不需要一个确切的值？

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

!important

模块级语句......

区分大小写

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

不区分大小写

Option Compare Binary

<强> InStr

区分大小写

Option Compare Text

不区分大小写

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

<强> Find method

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

<强> Regex

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

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

<强> Custom Character Analysis

如果你愿意，你甚至可以通过角色比较进行角色扮演。我之前已经完成了这项工作，以实现统计数据并找到近似/最佳猜测匹配。

这是一个示例，说明如何制作像InStr这样的函数，允许匹配容差......

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

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

1 个答案: