多行数据比较后，数值最大的那行标粗

xuanzhuandan

各位前辈，

我手上有一批如下数据，比较最后那一列数，看一下哪一行数最大将它标粗。



请各位前辈帮帮忙。详情请见附件谢谢。 模拟附件.rar (27.37 KB, 下载次数: 8)

2017-8-6 21:54 上传

点击文件名下载附件

duquancai

我给你这一行标记“高亮黄色”，以便效果看得清楚！！！

Sub shishi()
    Dim doc As Document, p&, reg As Object, d As Object, mt, k()
    Set doc = ActiveDocument: doc.Content.HighlightColorIndex = 0
    doc.Content.Find.Execute "^w^p", , , , , , , , , "^p", 2
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True: reg.Pattern = "\d+(?:\.\d+)?%\r"
    Set d = CreateObject("Scripting.Dictionary")
    With doc
        p = .ComputeStatistics(2)
        For i = 1 To p
            With .Range(.GoTo(1, 1, i).Start, IIf(i = p, .Content.End, .GoTo(1, 1, i + 1).Start))
                For Each mt In reg.Execute(.Text)
                    m = mt.FirstIndex: n = mt.Length
                    With doc.Range(m + .Start, .Start + m + n - 2)
                        d(.Text) = d(.Text) & "|" & .Start
                    End With
                Next
            End With
            k = d.keys: WordBasic.SortArray k(), 1: t = Mid(d(CStr(k(0))), 2)
            If InStr(t, "|") Then
                it = Split(t, "|")
                For j = 0 To UBound(it)
                    With doc.Range(it(j), it(j))
                        .Expand 4: .HighlightColorIndex = 7
                    End With
                Next
            Else
                With doc.Range(t, t)
                    .Expand 4: .HighlightColorIndex = 7
                End With
            End If
            d.RemoveAll
        Next
    End With
End Sub

duquancai

我真后悔写这个代码！！！绝对的伸手党。