2017-04-05 91 views
3

因此,我需要在VBA中创建一个Excel宏,它将搜索字符串,然后将其与我选择的预设字符串进行比较,然后更改单元格的值另一张纸。在Excel工作簿中搜索特定字符串

它是这样的:

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 

宏作品.......如果我删除了第一对(通过搜索张一)只要我在片“我的字符串”在哪里。否则,它不起作用。由于有17张纸,处理需要很长时间,超过一分钟。

为什么不工作?我在这里阅读了很多帖子,微软开发者论坛,一个名为Tech on the Net的网站,还有一些我错过了,但我不知道为什么。

任何人都可以指向正确的方向吗?

+1

这是这么长时间,因为你是循环通过每一行,所有100万+,这是超过1700万循环。这将需要一些时间,找到与每个工作表上的数据最后一行并循环到。 –

+1

你知道你在写最后一张工作表上的同一个单元格并且将'233“写入并重写,对吧? – Jeeped

+1

你也有'Rows.Count',这是不合格的。它只计算活动工作表上的行。您需要使用'WS',即'For A = 1到WS.Rows.Count','... Left(WS.Cells(A,33),')来限定它,'Cells()'。 ..' – BruceWayne

回答

3

使用With 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 

您需要前缀行,范围及与细胞内时,随着一结束... With块一段像.Rows....Range(...).Cells(...)调用。这用With With End With描述的父工作表来标识它们。

我还对vbTextCompare进行了不区分大小写的比较。

在同一个工作表上,还有一个写入和重写233到同一单元格的问题,但那是另一回事。

+0

不要担心233,让我担心233。我也会尝试这种方法,避免使用一个额外的变量,这对于未来的参考很有用。谢谢,伙计。 – Tato

1

我在这里弯曲了一些规则,但我想展示如何使用内置的FIND函数来显着加快速度。简单地说,我们将只处理C列中的每张表格;我们将使用FIND函数来查找列C中包含搜索字符串的行号....然后,我们将仔细检查该单元格,以查看您的搜索字符串是否在前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