Vba 更改特定位置字符的颜色

我在MS Word（2016）中有一张表，表中有1到7位数字（从1到数百万），我需要所有的数字，成千上万的数字都是绿色，成千上万的数字是蓝色，几十万的数字是红色。 你能帮我使用vba脚本吗

Sub creatable()

Dim docNew As Document
Dim tableNew As Table
Dim celltable As Cell

Dim X As Integer
Dim y As Integer
Dim cnt As Integer
Dim Rndm As Long
Dim a As Long
Dim b As Long
 Dim celTable As Cell
 Dim intCount As Integer
 Dim intChar As Integer


a = CInt((Rnd() + 1) * (Int((2025 * Rnd()) + 1)))
b = CInt((Rnd() + 1) * (Int((4355 * Rnd()) + 1)))
Rndm = a + b

Set docNew = Documents.Add
Set tableNew = docNew.Tables.Add(Selection.Range, 6, 12)

For y = 1 To 12
With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * X
  End With
 For X = 1 To 6
  With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * y
  End With
Next
Next

 For Each celTable In tableNew.Range.Cells
 intChar = celTable.Range.Characters.Count
If celTable.Range.Characters.Count = 1 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 End If
 If celTable.Range.Characters.Count = 2 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 End If
 If celTable.Range.Characters.Count = 3 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 End If
 If celTable.Range.Characters.Count = 4 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 End If
 If celTable.Range.Characters.Count = 5 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 End If
 If celTable.Range.Characters.Count = 6 Then
celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 End If
 If celTable.Range.Characters.Count = 7 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 7).Font.ColorIndex = wdGreen
 End If

 intCount = intCount + 1

 Next celTable

End Sub

找到的解决方案（不完美，但至少有效）：

---

你做过什么样的研究？请提供您尝试过的代码，并解释它如何不起作用。请注意，StackOverflow不是教程或代码编写服务，如中所述。我在其中有一个表和随机值。我可以计算每个数字的长度，但不知道如何正确设置颜色：

Sub creatable()

Dim docNew As Document
Dim tableNew As Table
Dim celltable As Cell

Dim X As Integer
Dim y As Integer
Dim cnt As Integer
Dim Rndm As Long
Dim a As Long
Dim b As Long
 Dim celTable As Cell
 Dim intCount As Integer
 Dim intChar As Integer


a = CInt((Rnd() + 1) * (Int((2025 * Rnd()) + 1)))
b = CInt((Rnd() + 1) * (Int((4355 * Rnd()) + 1)))
Rndm = a + b

Set docNew = Documents.Add
Set tableNew = docNew.Tables.Add(Selection.Range, 6, 12)

For y = 1 To 12
With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * X
  End With
 For X = 1 To 6
  With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * y
  End With
Next
Next

 For Each celTable In tableNew.Range.Cells
 intChar = celTable.Range.Characters.Count
  If celTable.Range.Characters.Count = 1 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
   End If
   On Error Resume Next
  If celTable.Range.Characters.Count = 2 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
     celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
   End If
  If celTable.Range.Characters.Count = 3 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
     celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
    celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 4 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 5 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 6 Then
celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 7 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 7).Font.ColorIndex = wdGreen
 End If
 On Error Resume Next
 intCount = intCount + 1

 Next celTable

End Sub