[已解决]excelvba多关键字排序

武林长风 · 发表于 2015-3-21 09:48

本帖最后由武林长风于 2015-3-21 23:13 编辑

excel2003版本的，请用VBA按关键字排序，注意关键字K4：K9的顺序是可变化的。点撤销排序时，回到原来的顺序。里面附了模拟结果。

新建文件夹.rar (8.62 KB, 下载次数: 11)

武林长风 · 发表于 2015-3-21 10:49

请vba大师相助！

武林长风 · 发表于 2015-3-21 12:48

{:1112:}

武林长风 · 发表于 2015-3-21 13:19

6个关键字排序，看来挺难弄的。

武林长风 · 发表于 2015-3-21 14:08

{:1112:}

武林长风 · 发表于 2015-3-21 15:37

{:1612:}

武林长风 · 发表于 2015-3-21 17:24

再次顶起来。

武林长风 · 发表于 2015-3-21 18:06

求vba高手给写个代码。

grf1973 · 发表于 2015-3-21 21:13

Dim arr '共有变量，记录原数所表
Sub 排序() '加辅助列，把所有条件连接起来后放在辅助列
Dim SortRange As Range
With Sheet1
r = .[a65536].End(3).Row
arr = .Range("a1:i" & r)
ReDim crr(1 To UBound(arr), 1 To 1)
For i = 3 To UBound(arr)
crr(i, 1) = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 7) & "," & arr(i, 5) & "," & arr(i, 8)
Next
.[j1].Resize(r, 1) = crr '加辅助列，把所有条件连接起来后放在辅助列
.Range("a3:j" & r).Sort key1:=.[j3] '按辅助列排序
.Columns("j").ClearContents '删除辅助列
End With
End Sub
Sub 取消排序()
On Error Resume Next
Sheet1.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

复制代码

grf1973 · 发表于 2015-3-21 21:14

.......................

		自动登录	找回密码
密码			注册