请帮忙修改代码

j_ack9

昨天排列三开奖517，代码有误，导致第三位7下面没有全部标红，请帮忙修改下：


Xrows = OpenWs.Range("E65536").End(xlUp).Row
'填充百位号
XArr = OpenWs.Range("F9:H" & Xrows).Value
Range("A" & Brow & ":C" & Xrows - 6).Value = XArr
'如果打开主界面则关闭
If ThisWorkbook.Sheets.Count = 1 Then NewWb.Close
'获得最后A列的有效行数
LastUsedRow = Range("A65536").End(xlUp).Row
'奖号区域
DataArr = Range("A3:C" & LastUsedRow).Value
'组合区域
ReDim ComFillArr(1 To LastUsedRow - Brow + 2, 1 To 198)
ReDim FillArr1(1 To LastUsedRow - Brow + 2, 1 To 198)
ReDim FillArr2(1 To LastUsedRow - Brow + 2, 1 To 198)
ReDim FillArr3(1 To LastUsedRow - Brow + 2, 1 To 198)
ReDim FillArr4(1 To LastUsedRow - Brow + 2, 1 To 198)
ReDim FillArr5(1 To LastUsedRow - Brow + 2, 1 To 198)

ReDim Arr1(1 To 15, 1 To 198)
ReDim Arr2(1 To 15, 1 To 198)
ReDim arr3(1 To 15, 1 To 198)
ReDim arr4(1 To 15, 1 To 198)
ReDim arr5(1 To 15, 1 To 198)

Set ComRange = Range("G" & Brow & ":GV" & 23)
ReDim ComArr(1 To 21, 1 To 198)
ReDim NumArr(1 To 20, 1 To 3)
'开始计算
For i = 1 To LastUsedRow - Brow + 1
'填充百
    TagNum = DataArr(i, 1)
    ComFillArr(i, 1) = TagNum
    ComFillArr(i, TagNum + 1 + 1) = TagNum
    '填充十个
    If i > 1 Then
        TagNum = DataArr(i, 2)
        TagNum = Int(Right(TagNum, 1))
        ComFillArr(i, 12) = TagNum
        ComFillArr(i, TagNum + 1 + 12) = TagNum
        TagNum = DataArr(i, 3)
        TagNum = Int(Right(TagNum, 1))
        ComFillArr(i, 23) = TagNum
        ComFillArr(i, TagNum + 1 + 23) = TagNum
    End If
      
'计算总遗漏
For j = 1 To 198
    If (j - 1) Mod 11 <> 0 Then
        If j > 1 And j <= 11 Then bgin = 1
        If j > 12 And j <= 22 Then bgin = 2
        If j > 23 And j <= 33 Then bgin = 2
        If j > 34 And j <= 44 Then bgin = 2
        If j > 45 And j <= 55 Then bgin = 3
        If j > 56 And j <= 66 Then bgin = 3
        If j > 67 And j <= 77 Then bgin = 1
        If j > 78 And j <= 88 Then bgin = 2
        If j > 89 And j <= 99 Then bgin = 2
        If j > 100 And j <= 110 Then bgin = 2
        If j > 111 And j <= 121 Then bgin = 3
        If j > 122 And j <= 132 Then bgin = 3
   
        n1 = 0
        For i = bgin To LastUsedRow - Brow + 2
            If ComFillArr(i, j) <> "" Then
                n1 = 0
            Else
                n1 = n1 + 1
                ComFillArr(i, j) = n1 & " "
            End If
        Next
    End If
Next
'遗漏1
For j = 1 To 18
    For i = 2 To LastUsedRow - Brow + 1
        n = 0
        For k = i - 1 To 1 Step -1
            If ComFillArr(i, 1 + (j - 1) * 11) <> ComFillArr(k, 1 + (j - 1) * 11) Then
                n = n + 1
            Else
                Exit For
            End If
        Next
        n = Int(Right(n, 1))
        FillArr1(i, 1 + (j - 1) * 11) = n
        FillArr1(i, 2 + n + (j - 1) * 11) = n
    Next
Next
For j = 1 To 198
    If (j - 1) Mod 11 <> 0 Then
        n1 = 0
        For i = 1 To LastUsedRow - Brow + 2
            If FillArr1(i, j) <> "" Then
                n1 = 0
            Else
                n1 = n1 + 1
                FillArr1(i, j) = n1 & " "
            End If
        Next
    End If
Next
For i = 1 To 15
    For j = 1 To 198
        Arr1(i, j) = FillArr1(UBound(FillArr1) - 15 + i, j)
    Next
Next

'遗漏2
For j = 1 To 18
    For i = 1 To LastUsedRow - Brow + 1
        n = 0
        For k = i - 1 To 1 Step -1
            If FillArr1(i, 1 + (j - 1) * 11) <> FillArr1(k, 1 + (j - 1) * 11) Then
                n = n + 1
            Else
                Exit For
            End If
        Next
        n = Int(Right(n, 1))
        FillArr2(i, 1 + (j - 1) * 11) = n
        FillArr2(i, 2 + n + (j - 1) * 11) = n
    Next
Next
For j = 1 To 198
    If (j - 1) Mod 11 <> 0 Then
        n1 = 0
        For i = 1 To LastUsedRow - Brow + 2
            If FillArr2(i, j) <> "" Then
                n1 = 0
            Else
                n1 = n1 + 1
                FillArr2(i, j) = n1 & " "
            End If
        Next
    End If
Next
For i = 1 To 15
    For j = 1 To 198
        Arr2(i, j) = FillArr2(UBound(FillArr2) - 15 + i, j)
    Next
Next

'号码区域重新赋值
For i = 1 To 20
    For j = 1 To 3
        NumArr(i, j) = DataArr(UBound(DataArr) - 20 + i, j)
    Next
Next
For i = 1 To 21
    For j = 1 To 198
        ComArr(i, j) = ComFillArr(UBound(ComFillArr) - 21 + i, j)
    Next
Next
Range("A3:C" & LastUsedRow).ClearContents
Range("A3:C22").Value = NumArr
'组合区域
ComRange = ComArr
'遗漏1
Range("G25:GV39").Value = Arr1
'遗漏2
Range("G41:GV55").Value = Arr2
'遗漏3
Range("G41:GV55").Offset(16 * (3 - 2), 0).Value = arr3

DrawingLine '连线

'字体恢复
Range("TagRed").Font.Color = RGB(256, 256, 256)
Range("TagRed").Font.Bold = False
For i = 39 To 263 Step 16
      Range(Cells(i, 8), Cells(i, 205)).Font.Color = RGB(256, 256, 256)
      Range(Cells(i, 8), Cells(i, 205)).Font.Bold = False
Next
For j = 1 To 6
    IntFir1 = Int(ComArr(20, 1 + (j - 1) * 33))
    For k = 0 To 9
        TagNum = Int(Right(IntFir1 + k, 1))
        ComRange.Cells(21, 13 + TagNum + (j - 1) * 33).Font.ColorIndex = 5
        ComRange.Cells(21, 13 + TagNum + (j - 1) * 33).Font.Bold = True
        TagNum = Int(Right(Abs(IntFir1 - k), 1))
        ComRange.Cells(21, 24 + TagNum + (j - 1) * 33).Font.ColorIndex = 5
        ComRange.Cells(21, 24 + TagNum + (j - 1) * 33).Font.Bold = True
    Next
Next
'遗漏循环标红
drawingRed ComArr, 1
drawingRed Arr1, 2
drawingRed Arr2, 3

Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
    HTObai
End Sub

Sub CountFun(xIndex As Integer)
'计算遗漏
For i = xIndex + 1 To LastUsedRow - Brow + 1
    n = 0
    For k = i - 1 To xIndex Step -1
        If ComFillArr(i, 11 * (xIndex - 1) + 1) <> ComFillArr(k, 11 * (xIndex - 1) + 1) Then
            n = n + 1
        Else
            Exit For
        End If
    Next
    n = Int(Right(n, 1))
    ComFillArr(i, 11 * xIndex + 1) = n
    ComFillArr(i, 11 * xIndex + n + 2) = n
Next
End Sub
Sub drawingRed(arr, i)  '遗漏标红
      '标红遗漏1
For j = 1 To 18
    For k = 0 To 9
        If Cells(23 + 16 * (i - 1), 8 + k + (j - 1) * 11).Font.ColorIndex = 5 Then
            strTem = arr(UBound(arr) - 1, 2 + k + (j - 1) * 11)
            If Right(strTem, 1) <> " " Then
                TagNum = 0
            Else
                TagNum = Val(strTem)
            End If
            TagNum = Int(Right(TagNum, 1))
            Cells(39 + 16 * (i - 1), 8 + TagNum + (j - 1) * 11).Font.ColorIndex = 5
            Cells(39 + 16 * (i - 1), 8 + TagNum + (j - 1) * 11).Font.Bold = True
        End If
    Next
Next
End Sub

Sub DrawingLine()
      '添加连线
For Each pSha In ActiveSheet.Shapes
    If pSha.Type = 9 Then pSha.Delete
Next
ReDim AddLineArr(1 To 20)
xAddNum = 0
For Each Rng In Range("MainData1")
    With Rng
        If Right(.Value, 1) <> " " Then
            xAddNum = xAddNum + 1
            AddLineArr(xAddNum) = .Value & "-" & (.Left + .Width / 2) & "-" & (.Top + .Height / 2)
        End If
    End With
    If xAddNum = 20 Then
        For i = 1 To 19
            SplitStr1 = Split(AddLineArr(i), "-")
            SplitStr2 = Split(AddLineArr(i + 1), "-")
            Value1 = SplitStr1(0)
            Left1 = SplitStr1(1)
            Top1 = SplitStr1(2)
            Value2 = SplitStr2(0)
            Left2 = SplitStr2(1)
            Top2 = SplitStr2(2)
            If Value1 <> Value2 Then
                With ActiveSheet.Shapes.AddLine(Left1, Top1, Left2, Top2).Line
                    .ForeColor.RGB = RGB(200, 200, 200)
                    .Weight = 0.01
                End With
            End If
        Next
        ReDim AddLineArr(1 To 20)
        xAddNum = 0
    End If
Next
'循环遗漏连线
For m = 1 To 15
      ReDim AddLineArr(1 To 14)
      xAddNum = 0
      For Each Rng In Union(Range("MainData2"), Range("gm25:gv38")).Offset(16 * (m - 1), 0)
          With Rng
              If Right(.Value, 1) <> " " Then
                  xAddNum = xAddNum + 1
                  AddLineArr(xAddNum) = .Value & "-" & (.Left + .Width / 2) & "-" & (.Top + .Height / 2)
              End If
          End With
          If xAddNum = 14 Then
              For i = 1 To 13
                  SplitStr1 = Split(AddLineArr(i), "-")
                  SplitStr2 = Split(AddLineArr(i + 1), "-")
                  Value1 = SplitStr1(0)
                  Left1 = SplitStr1(1)
                  Top1 = SplitStr1(2)
                  Value2 = SplitStr2(0)
                  Left2 = SplitStr2(1)
                  Top2 = SplitStr2(2)
                  If Value1 <> Value2 Then
                      With ActiveSheet.Shapes.AddLine(Left1, Top1, Left2, Top2).Line
                          .ForeColor.RGB = RGB(200, 200, 200)
                          .Weight = 0.01
                      End With
                  End If
              Next
              ReDim AddLineArr(1 To 14)
              xAddNum = 0
          End If
      Next
Next
End Sub

j_ack9

如图示，昨天排列三开奖517，代码有误，导致第三位7下面没有全部标红，请帮忙修改下：