excel吧 关注：282,301贴子：1,559,747
- 4回复贴，共1页
不感兴趣
开通SVIP免广告
我没有看你的全文，只是一个思路 如果每个名字后面如果都有(号备注，那么主要统计红色的（和黑色的(各有多少个就行。
Sub CountColorsIgnoringNewLines() Dim cell As Range Dim redCount As Long, blackCount As Long Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") ' Adjust the sheet name accordingly Set cell = ws.Range("A1") redCount = 0 blackCount = 0 ' Loop through each character in the cell For i = 1 To Len(cell.Value) ' Ignore new line characters If Asc(cell.Characters(i, 1).Text) <> 10 Then If cell.Characters(i, 1).Font.Color = vbRed Then redCount = redCount + 1 ElseIf cell.Characters(i, 1).Font.Color = RGB(0, 0, 0) Then ' or vbBlack blackCount = blackCount + 1 End If End If Next i ' Output the results to another cell ws.Range("B1").Value = "Red color: " & redCount & " Black color: " & blackCountEnd Sub
Sub CountColorsIgnoringNewLines() Dim cell As Range Dim redCount As Long, blackCount As Long Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") ' Adjust the sheet name accordingly Set cell = ws.Range("A1") redCount = 0 blackCount = 0 ' Loop through each character in the cell For i = 1 To Len(cell.Value) ' Ignore new line characters If Asc(cell.Characters(i, 1).Text) <> 10 Then If cell.Characters(i, 1).Font.Color = vbRed Then redCount = redCount + 1 ElseIf cell.Characters(i, 1).Font.Color = RGB(0, 0, 0) Then ' or vbBlack blackCount = blackCount + 1 End If End If Next i ' Output the results to another cell ws.Range("B1").Value = "Red color: " & redCount & " Black color: " & blackCountEnd Sub
