按最大值排序,然后将值加到最后

时间:2019-06-24 09:53:21

标签: excel vba sorting

我有一个Groovy宏,它创建了一个唯一列表(从X4开始),但是我需要它来按AC列中的值对该新范围进行排序。排序后,我需要在X列列表的底部添加“现金”值。

希望如此,这是现有的宏:

Sub Get_unique()
Dim v
v = getUniqueArray(Range("AI2:AI50000"))
If IsArray(v) Then
   Range("x4").Resize(UBound(v)) = v

End If

End Sub



Public Function getUniqueArray(inputRange As Range, _
                                Optional skipBlanks As Boolean = True, _
                                Optional matchCase As Boolean = True, _
                                Optional prepPrint As Boolean = True _
                                ) As Variant

Dim vDic As Object
Dim tArea As Range
Dim tArr As Variant, tVal As Variant, tmp As Variant
Dim noBlanks As Boolean
Dim cnt As Long

On Error GoTo exitFunc:
If inputRange Is Nothing Then GoTo exitFunc

With inputRange
    If .Cells.Count < 2 Then
        ReDim tArr(1 To 1, 1 To 1)
        tArr(1, 1) = .Value2
        getUniqueArray = tArr
        GoTo exitFunc
    End If

    Set vDic = CreateObject("scripting.dictionary")
    If Not matchCase Then vDic.compareMode = vbTextCompare

    noBlanks = True

    For Each tArea In .Areas
        tArr = tArea.Value2
        For Each tVal In tArr
            If tVal <> vbNullString Then
                vDic.Item(tVal) = Empty
            ElseIf noBlanks Then
                noBlanks = False
            End If
        Next
    Next
End With

If Not skipBlanks Then If Not noBlanks Then vDic.Item(vbNullString) = Empty

'this is done just in the case of large data sets where the limits of
'transpose may be encountered
If prepPrint Then
    ReDim tmp(1 To vDic.Count, 1 To 1)
    For Each tVal In vDic.Keys
        cnt = cnt + 1
        tmp(cnt, 1) = tVal
    Next
    getUniqueArray = tmp
Else
    getUniqueArray = vDic.Keys
End If

exitFunc:
Set vDic = Nothing
End Function

那有可能吗?感谢您的帮助:)

0 个答案:

没有答案