时间戳

首页 > 解决方案 > 使用 VBA 的搜索按钮

excel - 使用 VBA 的搜索按钮

问题描述

此代码假设正在从另一个工作表中查找关键字。它工作正常，但我必须从其他工作表中输入确切的工作。我该如何改进它以使其仅搜索关键字。例如，如果我想搜索 Red Car，我只想输入 Red。

Private Sub CommandButton1_Click()
totalsheets = Worksheets.Count
mykeyword = Worksheets("MasterSheet").Cells(2, 8).Value
For i = 1 To totalsheets

If Worksheets(i).Name <> "MasterSheet" Then
lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row

For j = 2 To lastrow
If Worksheets(i).Cells(j, 1).Value = mykeyword Then
Worksheets("MasterSheet").Activate
lastrow = Worksheets("MasterSheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("MasterSheet").Cells(lastrow + 1, 1).Value =   Worksheets(i).Name
Worksheets("MasterSheet").Cells(lastrow + 1, 2).Value = Worksheets(i).Cells(j, 2).Value
Worksheets("MasterSheet").Cells(lastrow + 1, 4).Value = Worksheets(i).Cells(j, 3).Value
Worksheets("MasterSheet").Cells(lastrow + 1, 3).Value = Worksheets(i).Cells(j, 4).Value

标签： excelvba

解决方案

考虑使用Range.Find这个，而不是嵌套循环。

If Worksheets(i).Cells(j, 1).Value = mykeyword Then

你在这里做一个严格的字符串相等。使用默认比较模式 ( Option Compare Binary)，这是一个区分大小写的相等测试。

您想要一个不区分大小写的部分匹配：=操作员不会删除它。Like运算符支持更合适的通配符。

If LCase(Worksheets(i).Cells(j, 1).Value) Like "*" & LCase(mykeyword) & "*" Then

使用LCase，您将每个单元格的小写表示与搜索词的小写表示进行比较。这有效，但并不理想。

将比较代码提取到单独模块中的自己的公共函数中，并Option Compare Text在该模块的顶部指定：

Option Explicit ' always.
Option Compare Text ' makes string comparisons case-insensitive
Option Private Module ' prevent exposing public functions as UDFs

Public Function IsPartialMatch(ByVal value As String, ByVal term As String) As Boolean
    IsPartialMatch = value Like "*" & term & "*"
End Function

现在你可以这样做：

If IsPartialMatch(Worksheets(i).Cells(j, 1).Value, mykeyword) Then

替代（更好）方法

相反，Range.Find您可以消除嵌套循环，只保留迭代工作表的外部循环；如果它没有找到您要查找的内容，则Range.Find返回，您所需要的就是：NothingIf Not (result) Is Nothing Then

Private Sub CommandButton1_Click() 'todo: give that button a meaningful name

    Dim masterSheet As Workshet
    Set masterSheet = Worksheets("MasterSheet")

    Dim mykeyword As String
    mykeyword = masterSheet.Cells(2, 8).Value

    Dim sheet As Worksheet
    For Each sheet In Worksheets
        If Not sheet Is masterSheet Then

            Dim result As Range
            Set result = sheet.Range("A:A").Find(mykeyword, LookIn:=XlFindLookIn.xlValues, LookAt:=XlLookAt.xlPart, MatchCase:=False)
            If Not result Is Nothing Then
                Dim lastRow As Long
                With masterSheet
                    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    .Cells(lastRow + 1, 1).Value = sheet.Name
                    .Cells(lastRow + 1, 2).Value = sheet.Cells(result.Row, 2).Value
                    .Cells(lastRow + 1, 4).Value = sheet.Cells(result.Row, 3).Value
                    .Cells(lastRow + 1, 3).Value = sheet.Cells(result.Row, 4).Value
                End With
            End If

        End If
    Next

End Sub

请注意，主工作表和包含搜索结果的任何工作表之间的第 3 列和第 4 列似乎是颠倒的 - 验证这是正确的，并考虑添加一个正当的评论。

推荐阅读