VBA根据内容文件types设置单元格的填充颜色

我正在尝试读取Excel列中的文档列表，并根据文件的types更改单元格的颜色。 但我做不到。 任何解决scheme

Public Sub Master() Dim TdCel As Range, FCell As Range Set TdCel = Range("A1:A25") For Each FCell In TdCel If FCell.Text = "*.pdf" Then FCell.Interior.ColorIndex = 10 ElseIf FCell.Value = "*.*.doc" Then FCell.Interior.ColorIndex = 9 ElseIf FCell.Value = "*.jpg" Then FCell.Interior.ColorIndex = 8 Else FCell.Interior.Color = vbWhite End If Next End Sub 

Answer 1

几点改进：

1. 定义您工作的工作表（在Set wS = ...更改工作表的名称 Set wS = ...
2. 使用With
3. 使用Select Case和Like ，对降低的单元格的值（ LCase() ）

工作scheme：

 Public Sub Master_JoaoTS() Dim wS As Worksheet Dim TdCel As Range, FCell As Range, CellVal As String Set wS = ThisWorkbook.Sheets("Sheet's Name") Set TdCel = wS.Range("A1:A25") For Each FCell In TdCel With FCell CellVal = LCase(.Value) With .Interior Select Case True Case CellVal Like "*.pdf" .ColorIndex = 10 Case CellVal Like "*.doc*" .ColorIndex = 9 Case CellVal Like "*.jpg" .ColorIndex = 8 Case Else .Pattern = xlNone End Select End With '.Interior End With 'FCell Next FCell End Sub 

Answer 2

很less的编辑来缩短代码（并使@ R3uK更不受欢迎…）

你可以使用Switch()函数

 Public Sub Master_JoaoTS() Dim FCell As Range Dim docType As String Dim clrIndex As Variant For Each FCell In Worksheets("myWorksheetName").Range("A1:A25").SpecialCells(xlCellTypeConstants, xlTextValues) With FCell docType = LCase(Right(.Value, Len(.Value) - InStrRev(.Value, "."))) clrIndex = Switch(docType = "pdf", 10, _ docType = "doc", 9, _ docType = "jpg", 8) If IsNull(clrIndex) Then clrIndex = 2 .Interior.ColorIndex = clrIndex End With Next FCell End Sub 

Answer 3

这里有一个解决scheme离你的原始代码不太远，使用InStr函数来查找子string“.pdf”，“.doc”和“.jpg”。

 Public Sub Master() Dim TdCel As Range, FCell As Range Set TdCel = Range("A1:A25") For Each FCell In TdCel If InStr(FCell, ".pdf") Then FCell.Interior.ColorIndex = 10 ElseIf InStr(FCell, ".doc") Then FCell.Interior.ColorIndex = 9 ElseIf InStr(FCell, ".jpg") Then FCell.Interior.ColorIndex = 8 Else FCell.Interior.Color = vbWhite End If Next End Sub