2013-04-11 50 views
3

我有一堆排列包含文本,如:InStr函數搜索和逗號細胞

dog,cat,mouse 
bat,dog,fly 
fish,beaver,horse 

我試圖尋找並突出顯示包含特定單詞的行:

Public Sub MarkDuplicates() 
Dim iWarnColor As Integer 
Dim rng As Range 
Dim rngCell As Variant 
Dim LR As Long 
Dim vVal 
Dim tRow 


LR = Cells(Rows.Count, "B").End(xlUp).Row 

Set rng = Range("B1:B" & LR) 
iWarnColor = xlThemeColorAccent2 

For Each rngCell In rng.Cells 
    tRow = rngCell.Row 
    If InStr(rngCell.Value, "dog") = 1 Then 
     rngCell.Interior.ColorIndex = iWarnColor 

    Else 
     rngCell.Interior.Pattern = xlNone 
    End If 
Next 

End Sub

只要單詞'dog'是逗號字符串中的第一個單詞,所以它會突出顯示第一行,但不會顯示第二行,因爲單詞'dog'出現在'bat' 。我是否需要先刪除逗號或者有沒有更好的方法來做到這一點?

+0

您是否嘗試'.Find'? http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/如果行數很多,循環遍歷列中的每一行將非常緩慢。當使用'.Find'時,使用'LookAt:= xlPart' – 2013-04-11 19:18:37

+0

你也可以使用Autofilter來達到你想要的。 – 2013-04-11 19:22:09

+0

或簡單地使用像這樣的比較'如果InStr(1,rngCell.Value,「dog」)<> 0 then'...此外,檢查'InStr'函數的參數。 – 2013-04-11 19:31:00

回答

5

看起來您的最終目標是根據「狗」是否在細胞中對行進行着色。這裏有一個不同的方式,甚至不涉及VBA(這個例子假設你的數據全部在A列中):

  1. 在右側新建一列。使用公式=IF(NOT(ISERROR(FIND("dog",A1))),1,0)。您可以稍後隱藏該列,以便用戶不會看到它。基本上,如果它有詞「狗」的地方,則返回1,否則爲0
  2. 選擇整個第一行
  3. 條件格式,去新規則
  4. 選擇使用公式
  5. 爲了您的公式,嘗試=$B2=1
  6. 現在你已經有條件有色一行,複製和粘貼格式到其他行。

現在所有的行都應該自動更新。

額外獎勵:如果此數據被格式化爲表格對象,則條件格式設置會在添加新行時自動轉移到新行。

+0

哇,沒有VB?黨!這很好。謝謝! – keeg 2013-04-11 19:41:11

+0

+ 1從我也建議一個非VBA的方式:) – 2013-04-11 19:42:01

+0

順便說一句,你不需要一個額外的列:)你可以設置條件格式與數據在同一列,並設置公式:) – 2013-04-11 19:44:18

3

此外上述

例我的意見1(使用.Find.Findnext

Option Explicit 

Public Sub MarkDuplicates() 
    Dim ws As Worksheet 
    Dim iWarnColor As Integer 
    Dim rng As Range, aCell As Range, bCell As Range 
    Dim LR As Long 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    iWarnColor = xlThemeColorAccent2 

    With ws 
     LR = .Range("B" & .Rows.Count).End(xlUp).Row 

     Set rng = .Range("B1:B" & LR) 

     rng.Interior.ColorIndex = xlNone 

     Set aCell = rng.Find(What:="dog", LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=False, SearchFormat:=False) 

     If Not aCell Is Nothing Then 
      Set bCell = aCell 
      aCell.Interior.ColorIndex = iWarnColor 
      Do 
       Set aCell = rng.FindNext(After:=aCell) 

       If Not aCell Is Nothing Then 
        If aCell.Address = bCell.Address Then Exit Do 
        aCell.Interior.ColorIndex = iWarnColor 
       Else 
        Exit Do 
       End If 
      Loop 
     End If 
    End With 
End Sub 

截圖

enter image description here

實施例2(使用自動過濾)

對於此確保有在小區A中標題B1

Option Explicit 

Public Sub MarkDuplicates() 
    Dim ws As Worksheet 
    Dim iWarnColor As Integer 
    Dim rng As Range, aCell As Range 
    Dim LR As Long 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    iWarnColor = xlThemeColorAccent2 

    With ws 

     '~~> Remove any filters 
     .AutoFilterMode = False 

     LR = .Range("B" & .Rows.Count).End(xlUp).Row 

     Set rng = .Range("B1:B" & LR) 

     With rng 
      .AutoFilter Field:=1, Criteria1:="=*dog*" 
      Set aCell = .Offset(1, 0).SpecialCells(xlCellTypeVisible) 
     End With 

     If Not aCell Is Nothing Then aCell.Interior.ColorIndex = iWarnColor 

     '~~> Remove any filters 
     .AutoFilterMode = False 
    End With 
End Sub