2017-04-05 89 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