用了以下VBA代码 但运行无反应：
Sub FillColumnBWithUniqueRedFontCell()
Dim ws As Worksheet
Dim cell As Range
Dim currentRow As Long
Dim lastRow As Long
Dim redFontColor As Long
Set ws = ThisWorkbook.Sheets("sheet1")
redFontColor = RGB(255, 0, 0)
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).row
For currentRow = 2 To lastRow
For Each cell In ws.Range(ws.Cells(currentRow, "E"), ws.Cells(currentRow, "J"))
If cell.Font.Color = redFontColor Then
ws.Cells(currentRow, "B").Value = cell.Value
Exit For
End If
Next cell
Next currentRow
End Sub

现在的代码 有什么问题呢?

你先找个红色字体的单元格，debug点print cell点font点color，看看这个颜色到底对不对。也许你以为它是你说的这个颜色，可实际上它有点误差呢？

另外你这个循环我觉得太啰嗦了，为什么不for each cell in range("E2:J" & lastRow)一次循环舒服点