vba - 根据文本值在 Excel 中设置单元格颜色 - VBA

Question

我正在编写一个脚本来在机器上运行ping。该脚本查找包含主机名的文本文件，并在 A 列中返回主机名，在 B 列中返回 ping 的状态(向上或向下)。

我需要将 B 列颜色更改为绿色(如果向上)和红色(如果向下)。

代码没有问题:

'# call excel applicationin visible mode

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Add

intRow = 2


'# Define Labels 

objExcel.Cells(1, 1).Value = "Machine Name"

objExcel.Cells(1, 2).Value = "Results"


'# Create file system object for reading the hosts from text file


Set Fso = CreateObject("Scripting.FileSystemObject")

Set InputFile = fso.OpenTextFile("MachineList.Txt")

'# Loop thru the text file till the end 

Do While Not (InputFile.atEndOfStream)

HostName = InputFile.ReadLine

'# Create shell object for Pinging the host machines

Set WshShell = WScript.CreateObject("WScript.Shell")

Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)


objExcel.Cells(intRow, 1).Value = HostName

'# use switch case for checking the machine updown status

Select Case Ping

Case 0 objExcel.Cells(intRow, 2).Value = "up"

Case 1 objExcel.Cells(intRow, 2).Value = "down"

End Select


intRow = intRow + 1

Loop

'# Format the excel

objExcel.Range("A1:B1").Select

objExcel.Selection.Interior.ColorIndex = 19

objExcel.Selection.Font.ColorIndex = 11

objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit

我尝试过的颜色(很多问题):

Sub ColorCells()
     Dim cel As Range
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     For Each cel In Range("B2:B90")
         Select Case LCase(Left(cel.Value, 1))
             Case "up"
                 cel.Interior.Color = vbGreen
             Case Else
                 cel.Interior.ColorIndex = xlColorIndexNone
         End Select
     Next cel
     Application.EnableEvents = True
     Application.ScreenUpdating = True
 End Sub

我得到了什么:

我想要什么:

Answer 1

要在插入“向上”或“向下”时更改单元格的颜色，只需将Select Case Ping替换为以下内容:

Select Case Ping

Case 0
    objExcel.Cells(intRow, 2).Value = "up"
    objExcel.Cells(intRow, 2).Interior.Color = vbGreen
Case 1
    objExcel.Cells(intRow, 2).Value = "down"
    objExcel.Cells(intRow, 2).Interior.Color = vbRed

End Select