酒店Excel

autocolor.vbs

Private Sub Worksheet_SelectionChange(ByVal target As Range)
Application.ScreenUpdating = True
On Error Resume Next
If InStr(ActiveCell, "fq") Then
With ActiveCell.Interior
    .Color = vbRed
    End With
With ActiveCell.Font
    .Color = vbWhite
    .Bold = True
    End With
        ActiveCell.Replace What:="fq", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
If InStr(ActiveCell, "mt") Then
With ActiveCell.Interior
    .Color = RGB(0, 200, 0)
    End With
With ActiveCell.Font
    .Color = vbWhite
    .Bold = True
    End With
        ActiveCell.Replace What:="mt", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
If InStr(ActiveCell, "tj") Then
With ActiveCell.Interior
    .Color = &HCDCD00
    End With
With ActiveCell.Font
    .Color = vbWhite
    .Bold = True
    End With
        ActiveCell.Replace What:="tj", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
If InStr(ActiveCell, "qn") Then
With ActiveCell.Interior
    .Color = &HCD5969
    End With
With ActiveCell.Font
    .Color = vbWhite
    .Bold = True
    End With
        ActiveCell.Replace What:="qn", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
If InStr(ActiveCell, "qt") Then
With ActiveCell.Interior
    .Color = &HFFFF
    End With
With ActiveCell.Font
    .Color = vbBlack
    .Bold = True
    End With
        ActiveCell.Replace What:="qt", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
End Sub

去哪儿 = qn （白色字体加粗，with 特定背景色）
美团 = mt （白色字体加粗，with 特定背景色）
途家 = tj （白色字体加粗，with 特定背景色）
番茄 = fq （白色字体加粗，with 特定背景色）
其他 = qt （黑色字体加粗，with 特定背景色）

另外，SelectionChange无法实现自动刷新。