在Excel工作簿中搜索特定字符串

So, I need to make an Excel Macro in VBA that will search for a string, then compare it with a pre-set string of my choice and then change the value of a cell in another Sheet.

因此，我需要在VBA中创建一个Excel宏来搜索字符串，然后将其与我选择的预设字符串进行比较，然后更改另一个Sheet中单元格的值。

It goes like this:

它是这样的：

Sub Macro1()

Dim A As Integer
Dim WS As Worksheet

Dim ToCompare, Coniburo As String

Coniburo = "My String"

For Each WS In Worksheets
    For A = 1 To Rows.Count
    ToCompare = Left(Cells(A, 3), 100)
        If InStr(ToCompare, Coniburo) > 0 Then
            Sheets("Last Sheet").Cells(21, 2).Value = "233"
        End If
    Next A
Next

The macro works....... If I remove the first For (the one that search through sheets) and as long as I'm in a sheet where "My string" is present. Otherwise, it doesn't work. It takes a long time to process, over a minute since there are 17 sheets.

宏工作.......如果我删除第一个For（搜索工作表的那个）并且只要我在一个表格中存在“我的字符串”。否则，它不起作用。由于有17张纸，因此需要很长时间才能处理。

Why isn't working? I read a lot of posts here, the Microsoft Dev forum, a site called Tech on the Net, and still there is something I'm missing, but I don't know why.

为什么不工作？我在这里阅读了很多帖子，微软开发论坛，一个名为Tech on the Net的网站，但我仍然缺少一些东西，但我不知道为什么。

Can anybody point me in the right direction?

任何人都能指出我正确的方向吗？

2 个解决方案

#1

Use a With ... End With to focus the parent worksheet for each iteration of the loop.

使用With ... End With来聚焦循环的每次迭代的父工作表。

Option Explicit

Sub Macro1()
    Dim a As Long, Coniburo As String, ws As Worksheet

    Coniburo = "My String"

    For Each ws In Worksheets
        With ws
            For a = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
                If CBool(InStr(Left(.Cells(a, 3), 100), Coniburo, vbTextCompare)) Then
                    Worksheets("Last Sheet").Cells(21, 2).Value = 233
                End If
            Next a
        End With
    Next

End Sub

You need to prefix Rows, Range and Cells calls with a period like .Rows... or .Range(...) or .Cells(...) when inside a With ... End With block. This identifies them with the parent worksheet described by the With .. End With.

在With ... End With块内部时，需要使用.Rows ...或.Range（...）或.Cells（...）等句点为Rows，Range和Cells调用加前缀。这将使用With .. End With描述的父工作表来识别它们。

I also made the comparison case-insensitive with vbTextCompare.

我还使用vbTextCompare对比较不区分大小写。

There is the remaining problem of writing and rewriting 233 into the same cell on the same worksheet but that is another matter.

在同一工作表上写入和重写233到同一单元格的问题仍存在，但这是另一回事。

#2

I've bent the rules a little here but I want to show how we could use the built in FIND function to speed things up dramatically. Simply, we'll work through each sheet within column C only; we'll use the FIND function to find the ROW number where column C contains your search string.... then we'll double-check that cell to see if your search string is within the first 100 characters, per your requirement. If it is, we'll consider that a match. In addition to your result of logging "233" into the sheet "Last Page" I've included some bright green highlighting just to help see what's going on...

我在这里略微遵守规则，但我想展示如何使用内置的FIND功能来大幅提升速度。简单地说，我们只会处理C列中的每个工作表;我们将使用FIND函数查找列C包含搜索字符串的ROW编号....然后我们将根据您的要求仔细检查该单元格以查看您的搜索字符串是否在前100个字符内。如果是，我们会考虑匹配。除了将“233”记录到“最后一页”表格中的结果之外，我还加入了一些亮绿色突出显示，以帮助了解正在发生的事情......

Sub findConiburo()
    Coniburo = "My String"
    For Each ws In Worksheets
        With ws.Range("C:C")
            myName = ws.Name 'useful for debugging

            queue = 1 'will be used to queue the FIND function

            x = 0 'loop counter

            Do 'loop to find multiple results per sheet

                On Error Resume Next 'Disable error handling

                'FIND Coniburo within ws column C, log row number:
                'Note ".Cells(queue, 1)" is a relative reference to the current WS, column C
                foundRow = .Find(What:=Coniburo, After:=.Cells(queue, 1), LookIn:=xlFormulas, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False).Row

                'If no result found then an error number is stored. Perform error handling:
                If Err.Number <> 0 Then
                    'No results found, don't do anything, exit DO to skip to next sheet:
                    Exit Do
                End If
                On Error GoTo 0 'Re-enable error handling

                If x = 0 Then
                    'first loop - log the first row result:
                    originalFoundRow = foundRow
                ElseIf foundRow = originalFoundRow Then
                    'Not the first loop. Same result as original loop = we're back at the start, so exit loop:
                    Exit Do
                End If

                'Update queue so next loop will search AFTER the previous result:
                queue = foundRow

                'check if the string is not only SOMEWHERE in the cell,
                'but specifically within the first 100 characters:
                ToCompare = Left(.Cells(foundRow, 1), 100)
                If InStr(ToCompare, Coniburo) > 0 Then
                    .Cells(foundRow, 1).Interior.ColorIndex = 4 'highlight green
                    Sheets("Last Sheet").Cells(21, 2).Value = "233"
                End If

                'Update loop counter:
                x = x + 1
            Loop
        End With
    Next ws
End Sub

#1