2015-03-12 2 views
1

У меня есть этот код, который работает хорошо:Excel VBA Если cell.Value = ... то

Sub colortest() 
Dim cell As Range 
For Each cell In Range("Range1") 
If cell.Value = "Word1" Then 
cell.Interior.Color = XlRgbColor.rgbLightGreen 
ElseIf cell.Value = "Word2" Then 
cell.Interior.Color = XlRgbColor.rgbOrange 
ElseIf cell.Value = "Word3" Then 
cell.Interior.Color = XlRgbColor.rgbRed 
End If 
Next cell 
End Sub 

Моя проблема значения работают только, если ячейка содержит только этот текст. Но мои ячейки обычно такие: «Что-то, 10254, 15/15, Word1 Другое слово« Мне нужен только Word1. Спасибо,

+1

Посмотрите ['InStr()' function] (http://www.techonthenet.com/excel/formulas/instr.php) –

+1

Или вы можете использовать 'Like' - обратите внимание, что он чувствителен к регистру. – Rory

ответ

3

Вы можете определить, если в определенное слово встречается в клетке с помощью

If InStr(cell.Value, "Word1") > 0 Then 

Если Слово1 находится в строке функции InStr() вернет расположение первого символа Слово1 в Струна.

0

Я думаю, что было бы разумнее использовать функцию «Найти» в Excel вместо цикла «Для каждого». Он работает намного быстрее и предназначен для таких действий. Попробуйте следующее:

Sub FindSomeCells(strSearchQuery As String) 

    Set SearchRange = Worksheets("Sheet1").Range("A1:A100") 
    FindWhat = strSearchQuery 
    Set FoundCells = FindAll(SearchRange:=SearchRange, _ 
          FindWhat:=FindWhat, _ 
          LookIn:=xlValues, _ 
          LookAt:=xlWhole, _ 
          SearchOrder:=xlByColumns, _ 
          MatchCase:=False, _ 
          BeginsWith:=vbNullString, _ 
          EndsWith:=vbNullString, _ 
          BeginEndCompare:=vbTextCompare) 
    If FoundCells Is Nothing Then 
     Debug.Print "Value Not Found" 
    Else 
     For Each FoundCell In FoundCells 
      FoundCell.Interior.Color = XlRgbColor.rgbLightGreen 
     Next FoundCell 
    End If 

End Sub 

Эта подпрограмма ищет некоторую строку и возвращает коллекции ячеек, заполняющих ваши критерии поиска. Затем вы можете делать все, что хотите, с ячейками в этой коллекции. Забыл добавить определение FindAll функции:

Function FindAll(SearchRange As Range, _ 
       FindWhat As Variant, _ 
       Optional LookIn As XlFindLookIn = xlValues, _ 
       Optional LookAt As XlLookAt = xlWhole, _ 
       Optional SearchOrder As XlSearchOrder = xlByRows, _ 
       Optional MatchCase As Boolean = False, _ 
       Optional BeginsWith As String = vbNullString, _ 
       Optional EndsWith As String = vbNullString, _ 
       Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' FindAll 
' This searches the range specified by SearchRange and returns a Range object 
' that contains all the cells in which FindWhat was found. The search parameters to 
' this function have the same meaning and effect as they do with the 
' Range.Find method. If the value was not found, the function return Nothing. If 
' BeginsWith is not an empty string, only those cells that begin with BeginWith 
' are included in the result. If EndsWith is not an empty string, only those cells 
' that end with EndsWith are included in the result. Note that if a cell contains 
' a single word that matches either BeginsWith or EndsWith, it is included in the 
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter 
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be 
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive 
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted, 
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are 
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided, 
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Dim FoundCell As Range 
Dim FirstFound As Range 
Dim LastCell As Range 
Dim ResultRange As Range 
Dim XLookAt As XlLookAt 
Dim Include As Boolean 
Dim CompMode As VbCompareMethod 
Dim Area As Range 
Dim MaxRow As Long 
Dim MaxCol As Long 
Dim BeginB As Boolean 
Dim EndB As Boolean 
CompMode = BeginEndCompare 
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then 
    XLookAt = xlPart 
Else 
    XLookAt = LookAt 
End If 
' this loop in Areas is to find the last cell 
' of all the areas. That is, the cell whose row 
' and column are greater than or equal to any cell 
' in any Area. 

For Each Area In SearchRange.Areas 
    With Area 
     If .Cells(.Cells.Count).Row > MaxRow Then 
      MaxRow = .Cells(.Cells.Count).Row 
     End If 
     If .Cells(.Cells.Count).Column > MaxCol Then 
      MaxCol = .Cells(.Cells.Count).Column 
     End If 
    End With 
Next Area 
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol) 
On Error GoTo 0 
Set FoundCell = SearchRange.Find(what:=FindWhat, _ 
     after:=LastCell, _ 
     LookIn:=LookIn, _ 
     LookAt:=XLookAt, _ 
     SearchOrder:=SearchOrder, _ 
     MatchCase:=MatchCase) 
If Not FoundCell Is Nothing Then 
    Set FirstFound = FoundCell 
    Do Until False ' Loop forever. We'll "Exit Do" when necessary. 
     Include = False 
     If BeginsWith = vbNullString And EndsWith = vbNullString Then 
      Include = True 
     Else 
      If BeginsWith <> vbNullString Then 
       If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then 
        Include = True 
       End If 
      End If 
      If EndsWith <> vbNullString Then 
       If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then 
        Include = True 
       End If 
      End If 
     End If 
     If Include = True Then 
      If ResultRange Is Nothing Then 
       Set ResultRange = FoundCell 
      Else 
       Set ResultRange = Application.Union(ResultRange, FoundCell) 
      End If 
     End If 
     Set FoundCell = SearchRange.FindNext(after:=FoundCell) 
     If (FoundCell Is Nothing) Then 
      Exit Do 
     End If 
     If (FoundCell.Address = FirstFound.Address) Then 
      Exit Do 
     End If 
    Loop 
End If 
Set FindAll = ResultRange 
End Function 
1

Вы можете использовать оператор Like с шаблоном, чтобы определить, существует ли данная подстрока в строке, например:

If cell.Value Like "*Word1*" Then 
'... 
ElseIf cell.Value Like "*Word2*" Then 
'... 
End If 

В этом примере * символ в "*Word1*" является символом подстановки, который соответствует нулю или нескольким символам.

ПРИМЕЧАНИЕ:Like оператор чувствителен к регистру, поэтому "Word1" Like "word1" ложно, более подробную информацию можно найти on this MSDN page.

Смежные вопросы