Range.Characters对象在循环中无法正常工作

下面是Excel VBA中的一个程序，它创build一个进度指示器。 我试图使进度指示器尽可能简单，但它仍然看起来很优雅，使用Unicode字符： 完整的块和精简的空间 。

Private Sub Play_Click() Dim iCounter As Long, iRow As Long, nRow As Long, _ Block As String, Progress As Long, iChar As Long Columns(1).ClearContents With Cells(2, 4) .ClearContents .Font.Color = vbBlue nRow = 100 For iRow = 1 To nRow For iCounter = 1 To 100 Cells(iRow, 1) = iCounter Next Progress = Int(iRow / 10) If Progress = iRow / 10 Then Block = Block & ChrW(9608) & ChrW(8201) '------------------ 'Option statements '------------------ End If .Value = Block & " " & iRow & " %" Next End With End Sub 

我想让进度指示器看起来像这样

在程序运行时，满块总是绿色的，百分比数字总是蓝色的 。 但是使用这三个选项陈述，

选项1

 .Characters(, 2 * Progress - 1).Font.Color = vbGreen 

选项2

  For iChar = 1 To Len(.Value) If Mid$(Text, iChar, 1) = ChrW(9608) Then .Characters(iChar, 1).Font.Color = vbGreen End If Next 

选项3

 GreenBlue 2 * Progress - 1 --------------------- Sub GreenBlue(GreenPart As Integer) Select Case GreenPart Case 1 To 19 Cells(2, 4).Characters(, GreenPart).Font.Color = vbGreen End Select End Sub 

我不断得到以下输出

什么是正确的方式来获得输出像第一张照片？

Answer 1

无论何时您更换单元格的值，所有新内容将从replace的第一个字符中选取其格式，因此整个内容将为绿色：如果您希望数字部分为是蓝色的

 Private Sub Play_Click() Dim iCounter As Long, iRow As Long, nRow As Long, _ Block As String, Progress As Long, iChar As Long, x As Long Columns(1).ClearContents With Cells(2, 4) .ClearContents .Font.Color = vbBlue nRow = 100 For iRow = 1 To nRow For iCounter = 1 To 100 Cells(iRow, 1) = iCounter Next Progress = Int(iRow / 10) If Progress = iRow / 10 Then Block = Block & ChrW(9608) & ChrW(8201) End If Application.ScreenUpdating = False 'reduce flashing during update .Value = Block & " " & iRow & " %" .Font.Color = vbBlue If Len(Block) > 0 Then .Characters(1, InStr(.Value, " ")).Font.Color = vbGreen End If Application.ScreenUpdating = True 'add some delay... For x = 1 To 1000 DoEvents Next x Next End With End Sub