[已解决]再次求助：VBA＿鼠标选取当前列自定义排序-求修改代码

happym8888 · 发表于 2012-2-6 21:05

蓝桥玄霜 · 发表于 2012-2-6 21:07

鼠标点击C列即可触发工作表事件。

yjwdjfqb · 发表于 2012-2-6 21:08

sunjing-zxl 发表于 2012-2-6 21:01
你工作表要改成什么样子。
该不会是大变样把

我的目的是，更改工作表时，我不更改VBA代码，也能正确进行排序

happym8888 · 发表于 2012-2-6 21:13

yjwdjfqb 发表于 2012-2-6 21:08
我的目的是，更改工作表时，我不更改VBA代码，也能正确进行排序

yjwdjfqb · 发表于 2012-2-6 21:28

爱疯发表于 2012-2-6 21:04
还是不大理解，只好猜了。

只修改了排序区域

附件.rar (28.03 KB, 下载次数: 6)

yjwdjfqb · 发表于 2012-2-6 21:30

happym8888 发表于 2012-2-6 21:13
楼主，你试过这里10楼的代码没有？
http://www.excelpx.com/forum.php?mod=redirect&goto=findpost&ptid ...

老师你好，我试了，可能是我表述的不清楚，我目的是，工作表改变时，不改变代码，也能正确排序。

排序的起始位置由鼠标来选择

sunjing-zxl · 发表于 2012-2-6 21:35

你要你工作表改变是按照你附件工作表向下扩展数据我的代码就能够达到目的

但是如果你的工作表大变样，那就不行了，就需要你提供你工作表到底要怎么变化。

yjwdjfqb · 发表于 2012-2-6 21:39

sunjing-zxl 发表于 2012-2-6 21:35
你要你工作表改变是按照你附件工作表向下扩展数据我的代码就能够达到目的

但是如果你的工作表大变样，那 ...

感谢老师不厌其烦的帮忙，具体的附件在15楼，请老师看附件，谢谢老师。

sunjing-zxl · 发表于 2012-2-6 21:41

早点说出你表格变动状态早解决了，用这个吧

Sub 排序()
Dim arr1, arr2, arr3
Dim i As Long, j As Long, k As Long, n As Long, m As Long
Dim Co As Long
'设置自定义排序的顺序
arr1 = Array("外妇科", "手术室", "内儿科", "西医科", "中医科", "耳鼻喉科", "放射科", "检验科", "B超室", "口腔科", "针灸科", "西药房", "中药房", "收费室", "疾控科", "合管办", "后勤科")
arr2 = Range("A1:N1")
For i = 1 To UBound(arr2, 2)
If arr2(1, i) = "科室" Then
Co = i
Exit For
End If
Next i
n = ActiveCell.Row '获取活动单元格行号
m = [A65536].End(xlUp).Row
If n = 1 Or n > m Then
MsgBox "活动行超出范围,不能排序"
Exit Sub
End If
arr2 = Range(Cells(n, 1), Cells(m, "N")) '活动单元格至最后一行数据赋值给数组arr2
ReDim arr3(1 To UBound(arr2), 1 To UBound(arr2, 2))
m = 0 '计数变量
For i = 0 To UBound(arr1)
For j = 1 To UBound(arr2)
If arr1(i) = arr2(j, Co) Then
m = m + 1
For k = 1 To UBound(arr2, 2)
arr3(m, k) = arr2(j, k)
Next k
End If
Next j
Next i
Cells(n, 1).Resize(UBound(arr3), UBound(arr3, 2)) = arr3
MsgBox "排序完成"
End Sub

复制代码

上清宫主 · 发表于 2012-2-6 21:43

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