用VBA怎样可以做到负数从小到大,正数从大到小排序,谢谢！

feixiangye

AB两列排序,A列相同的排一起,B列:负数~从小到大,正数~从大到小排序，如下案例是手工排的，原数据有几千行,求用VBA怎么写，谢谢！

名称	数量
A	-100
A	-99
A	80
A	45
B	-997
B	9000
B	100
B	34
C	-900
C	-100
C	-12
C	978
C	876
C	675
C	123

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a2:b" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To 1)
   
8.     For i = 1 To UBound(arr)
   
9.       If arr(i, 2) < 0 Then
   
10.         brr(i, 1) = 9 * 10 ^ 8 + arr(i, 2) * (-1)
    
11.       Else
    
12.         brr(i, 1) = 1 * 10 ^ 8 + arr(i, 2)
    
13.       End If
    
14.     Next
    
15.     .Range("c2").Resize(UBound(brr), 1) = brr
    
16.     .Range("a2:c" & r).Sort key1:=.Range("a2"), order1:=xlAscending, key2:=.Range("c2"), order2:=xlDescending, Header:=xlNo
    
17.     .Columns(3).ClearContents
    
18.   End With
    
19. End Sub
    

复制代码

chxw68

增加一个辅助列。

feixiangye

chxw68 发表于 2018-7-10 16:53
增加一个辅助列。

谢谢褚老师,就是想要这个结果，非常感谢！

zopey

Sub 按钮1_Click()
Range("f2:g65535").ClearContents
Dim arr()

Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName

Sql2 = "select * from [sheet1$a:b] where 名称 is not null order by 名称,数量/abs(数量),abs(数量) desc"
    Set rst2 = CreateObject("adodb.Recordset")
    rst2.Open Sql2, cnn, 1, 1
    k = 0
    ReDim arr(1 To rst2.RecordCount, 1 To 2)
    Do While Not rst2.EOF
       k = k + 1
       arr(k, 1) = rst2("名称")
       arr(k, 2) = rst2("数量")
    rst2.movenext
    Loop

cnn.Close
Set cnn = Nothing

[f2].Resize(k, 2) = arr
End Sub


book3.zip (13.94 KB, 下载次数: 15)

2018-7-10 17:06 上传

点击文件名下载附件

feixiangye

zopey 发表于 2018-7-10 17:07
Sub 按钮1_Click()
Range("f2:g65535").ClearContents
Dim arr()

非常感谢您的帮助