2015-06-04 45 views
1

我已經形成了代碼做的問題是試圖得到它找到多個結果的搜索。目前它將返回每個選項卡上字符串的第一個位置,但隨後繼續。當我實現While循環當前註釋掉它似乎找到第一個結果,然後轉義循環。VBA在Excel中搜索字符串在多個選項卡,並返回地點

我不知道是否有一個古怪的VBA循環,我失蹤或我雖然檢查是不是很正確,但我試圖通過分解調試和使用消息框,但除了縮小之外無濟於事我相信問題在while循環代碼中。

Public Function GetSearchArray(strSearch As String) As String 
Dim strResults As String 
Dim SHT As Worksheet 
Dim rFND As Range 
Dim sFirstAddress As Range 
For Each SHT In ThisWorkbook.Worksheets 
    'MsgBox "Looping over worksheets" 
    Set rFND = Nothing 

    With SHT.UsedRange 
     'MsgBox "Searching for" & strSearch 

     Set rFND = .Cells.Find(What:="*" & strSearch & "*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False) 
     If Not rFND Is Nothing Then 

      'Save first result so we can exit the loop 
      If sFirstAddress Is Nothing Then 
       MsgBox "We have a result and sFirstAddress is nothing" 
       Set sFirstAddress = rFND 
      End If 


      'Need to loop within the sheet to keep finding results 
      'While (Not rFND Is Nothing) And rFND <> sFirstAddress 

       'Deal with the results and build a string 
       If strResults = "" Then 
        'MsgBox "No prev results" 
        strResults = "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")" 
        MsgBox "First result " & strResults 
       Else 
        strResults = strResults & "|" & "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")" 
        MsgBox strResults 
       End If 

       Set rFND = .FindNext(rFND) 


      'Wend 

     End If 
    End With 
MsgBox "End sheet loop.." 
Next 
MsgBox "Finished going over sheets" 
MsgBox strResults 
End Function 

回答

0

像這樣的東西應該爲你工作:

Public Function GetSearchArray(strSearch As String) As String 

    Dim ws As Worksheet 
    Dim rngFound As Range 
    Dim strFirst As String 
    Dim strWSname As String 

    For Each ws In ActiveWorkbook.Sheets 
     Set rngFound = ws.UsedRange.Find(strSearch, ws.UsedRange.Cells(ws.UsedRange.Cells.Count), xlValues, xlPart) 
     If Not rngFound Is Nothing Then 
      strWSname = ws.Name 
      If InStr(1, ws.Name, " ", vbTextCompare) > 0 Then strWSname = "'" & strWSname & "'" 
      strFirst = rngFound.Address 
      Do 
       GetSearchArray = GetSearchArray & "|" & strWSname & "!" & rngFound.Address 
       Set rngFound = ws.UsedRange.Find(strSearch, rngFound, xlValues, xlPart) 
      Loop While rngFound.Address <> strFirst 
     End If 
    Next ws 

    If Len(GetSearchArray) > 0 Then GetSearchArray = Mid(GetSearchArray, 2) 

End Function 

然後調用的函數,使用這樣的:

Sub tgr() 

    MsgBox Replace(GetSearchArray("test"), "|", Chr(10)) 

End Sub 
+0

這與我想要的完全一樣。一個擴展 - 我將如何從單元中調用它並將輸出返回到單元格中?我試過第二個函數調用你的重寫,但它不工作。 – mhollander38

+0

在一個單元格:'= GetSearchArray(「測試」)'如果你想要的結果要以比其他的東西分隔「|」,你可以使用Substitue,如:'=替換(GetSearchArray(「測試」),「| 「,」,「)' – tigeravatar

+0

嗯我試過,但單元格只是錯誤和顯示#VALUE! – mhollander38

1

您需要循環回Set rFND = .Cells.Find(What:="*" & strSearch & "*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)行代碼達到While循環之前,現在不發生,rFND 總是等於sFirstAddress。

我不知道來存儲您的地址結果,然後檢查他們爲你循環的最有效的方式,但我相信有人可以幫你最後一部分。我懷疑它會將每個結果存儲在一個數組中,並檢查每個新的結果對數組,直到找不到新結果,然後移動到下一個表。

你可能也不得不改變你的查找命令在最後發現結果開始,如果在同一個地方,每次我想它會一遍又一遍發現相同的結果開始。我不確定,我沒有用過多少。

+0

沒有? While循環將被完全跳過。 '(不rFND是Nothing)'部分將會被滿足,但'rFND <> sFirstAddress'不會。你在他們之間使用了'And',因爲他們都不滿意,直接去了WEnd並繼續。 – puzzlepiece87

+1

哈對不起,您的無限循環的問題消失了,你必須想到這一點:) – puzzlepiece87

+0

對不起,我意識到我的評論是不正確的,從而將其刪除。如你所說。 :) – mhollander38

相關問題