Excel VBA中搜索细胞

问题描述:

是否有可能在Excel中搜索字符串,并将其对字符串的另一个阵列上的另一列Excel VBA中搜索细胞

例如比较,

我有一系列的A1用户。我想在列搜索并为您在A1单元格的所有用户 对“名单” C.

enter image description here

我想看到的结果的东西,是这样的。可能?

enter image description here

问候, 特里

+2

是绝对有可能的。 –

我已经出来了,我自己的答案和它的工作,虽然它有点冗长。

Sub search() 
 
    Dim users As Variant 
 
    Dim search As Boolean 
 
    Dim j As Integer 
 
    Dim found As Integer 
 
    Dim ArraySize As Integer 
 
    Dim listSize As Integer 
 
    Dim listOfUsers As Integer 
 
    
 
    listSize = 2 
 
    
 
    search = False 
 
    
 
    'Count number of teachers in List Of Users column 
 
    listOfUsers = Range("C2:C1000").Cells.SpecialCells(xlCellTypeConstants).Count 
 
    
 
    While Cells(listSize, 1).Value <> "" 
 
     found = 0 
 
     users = Split(Cells(listSize, 1).Value, ",") 
 
     ArraySize = UBound(users, 1) ' Find array size 
 
     
 
     'Loop until each cell string is done 
 
     For i = 0 To ArraySize 
 
      j = 2 
 
      While search = False 
 
       If Trim(users(i)) = Cells(j, 3).Value Then 
 
        Cells(listSize, 2).Value = Trim(users(i)) 
 
        found = found + 1 
 
        search = True 
 
       ElseIf j > listOfUsers Then 
 
        search = True 
 
       Else 
 
        j = j + 1 
 
       End If 
 
      Wend 
 
      search = False 
 
     Next i 
 
     If found <> ArraySize + 1 Then 
 
     Cells(listSize, 2).Value = "Users not found" 
 
     Else 
 
     Cells(listSize, 2).Value = "All users found" 
 
     End If 
 
     listSize = listSize + 1 
 
    Wend 
 
    
 
End Sub

问候, 特里

你可以使用Dictionary对象

Option Explicit 

Sub search() 
    Dim usersRng As Range, cell As Range 
    Dim elem As Variant 
    Dim SearchResults As String 
    Dim searchResultsArray As Variant 
    Dim iCell As Long 

    Set usersRng = Range("A2", Cells(Rows.COUNT, "A").End(xlUp)) '<-- set usersRng in column "A" from row 2 down to last not empty row 
    ReDim searchResultsArray(1 To usersRng.COUNT) '<--| size the search result array to the actual number of cells to be processed 

    With CreateObject("Scripting.Dictionary") 'create and reference a 'dictionary' 
     'store all values from "list of users" column in reference dictionary 
     For Each cell In Range("C2", Cells(Rows.COUNT, "C").End(xlUp)) 
      .Add cell.Value, Null 
     Next cell 

     For Each cell In usersRng '<--| loop through "users" column cells 
      SearchResults = "" '<--| initialize search results 
      For Each elem In Split(Replace(cell.Value, " ", ""), ",") '<--| loop through current cell users 
       If Not .Exists(elem) Then SearchResults = SearchResults & elem & "," '<--| if current user is not in the dictionary then update 'searchResults' string 
      Next elem 
      If SearchResults = "" Then '<--| if all users have been found... 
       SearchResults = "All users found" '<--| ... then set 'searchResults' accordingly 
      Else '<--| otherwise... 
       SearchResults = Left(SearchResults, Len(SearchResults) - 1) & " not found" '<--| ... add " not found" to the already built list of not found users 
      End If 
      iCell = iCell + 1 '<--| update 'searchResultsArray' index 
      searchResultsArray(iCell) = SearchResults '<--| update 'searchResultsArray' 
     Next cell 
     Range("B2").Resize(usersRng.COUNT).Value = Application.Transpose(searchResultsArray) '<--| write down 'searchResultsArray' from cell "B2" downwards 
    End With 
End Sub 
+0

寻求帮助。 :) – xingtan

+0

不客气。字典允许比仅循环单元更快的代码。这同样适用于使用数组,然后将它们写入单元格。最后,如果我的答案解决了你的问题,你可能想接受它。谢谢! – user3598756

+0

@xingtan,我看到你不停地问,并得到很好的答案,但从来没有标记为接受。根据本网站的规定(请参阅[当某人回答我的问题时该怎么办?](http://stackoverflow.com/help/someone-answers)),您必须点击答案旁边的复选标记以将其从灰色填充。谢谢! – user3598756