基于数组突出显示excel单元格的代码

时间:2012-04-23 16:47:11

标签: excel vba excel-vba

有人可以帮我弄清楚如何修改它,以便搜索和突出显示关键字来自不同表格中的范围,例如表格(“数据表”)。范围(“B3:B41”)?

Sub Highlight_Keywords() 

Dim vntWords As Variant 
Dim lngIndex As Long 
Dim rngFind As Range 
Dim strFirstAddress As String 
Dim lngPos As Long 

vntWords = Array("sales", "fms", "siebel", "knowledgeview", "bcs", "sap", "icm", "deal hub", "its", "stg", "ssm", "gbs", "presentation central", "tsm", "methodweb", "isc", "iot", "wwgpe", "crm", "salesone", "knac", "igs", "marketing", "edvisor", "partnerworld", _ 
"golden circle", "gs method", "knowledge view", "stsm", "smb", "spc", "passport advantage", "references", "global business services", "sales one", "igf", "market intelligence", "ibv", "itsm", "presentation", _ 
"bcs marketplace", "isv", "method web", "knowledgegate", "system sales", "field management system", "crm siebel", "global technology services", "issc", "techline", "gsar", "finance", "global services", "ontarget", "ssi", "bcrs", "sales productivity center", _ 
"fastpass", "gs risk", "ica", "referral", "delivery excellence", "isca", "powerpoint template", "sage", "icm assetweb", "ibm global services", "customer references", "presentation template", "sales portal", "business intelligence", "7 keys", "method", "systems sales", _ 
"what makes you special", "stg stsm 2006", "reference", "salary letter", "sales plan", "gbsc", "global services method", "gsmethod", "sales compass", "attach connector", "seven keys", "value creation", "fss", "gsm", "know your industry", "public sector") 


With ActiveSheet.UsedRange 
    For lngIndex = LBound(vntWords) To UBound(vntWords) 
        Set rngFind = .Find(vntWords(lngIndex), LookIn:=xlValues, LookAt:=xlPart) 
        If Not rngFind Is Nothing Then 
            strFirstAddress = rngFind.Address 
            Do 
                lngPos = 0 
                Do 
                    lngPos = InStr(lngPos + 1, rngFind.Value, vntWords(lngIndex), vbTextCompare) 
                    If lngPos > 0 Then 
                        With rngFind.Characters(lngPos, Len(vntWords(lngIndex))) 
                            .Font.Bold = True 
                            .Font.Size = .Font.Size + 2 
                            .Font.ColorIndex = 3 
                        End With 
                    End If 
                Loop While lngPos > 0 
                Set rngFind = .FindNext(rngFind) 
            Loop While rngFind.Address <> strFirstAddress 
        End If 
    Next 
End With 
End Sub  

谢谢!

1 个答案:

答案 0 :(得分:2)

vntWords =  Sheets("DATASHEET").Range("B3:B41").Value
...
For x=lbound(vntWords,1) to ubound(vntWords,1)
   'look for vntWords(x,1)
Next x