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

yjwdjfqb · 发表于 2012-2-7 00:29

爱疯发表于 2012-2-7 00:25
问题解决了么

辛苦老师了，我比较了下，附件6要好些！
真的很感谢老师。

yjwdjfqb · 发表于 2012-2-7 00:35

爱疯发表于 2012-2-7 00:25
问题解决了么

如果老师，有时间帮我研究下，像这样行不行

就是，当我点C4时，就从第四行（包括第四行）以下，开始排序，排序的列是C列，其它的都不用考虑，

也不用再设置排序的操作区域（直接第四行（包括第四行）以下所有行）

以“选定扩展方式”排序

yjwdjfqb · 发表于 2012-2-7 00:36

爱疯发表于 2012-2-7 00:25
问题解决了么

老师，你还有时间吧，我等你帮我做下。。。

爱疯 · 发表于 2012-2-7 00:42

yjwdjfqb 发表于 2012-2-7 00:29
辛苦老师了，我比较了下，附件6要好些！
真的很感谢老师。

能解决就好。这问题我只是修改了如何选择数据源，绝大部分是happym8888帮忙写的。只是他这会儿没空，我恰好有点。要谢你要多谢谢他！

我觉得，应该再说明下，在求助时切勿重复发帖，这也是很多论坛的规定。为避免给大家造成不好的示范和习惯，你将受到一定处罚。希望你能理解并改正，继续支持论坛。

爱疯 · 发表于 2012-2-7 00:49

yjwdjfqb 发表于 2012-2-7 00:35
如果老师，有时间帮我研究下，像这样行不行

就是，当我点C4时，就从第四行（包括第四行）以下，开始排 ...

附件7.rar (20.55 KB, 下载次数: 5)

yjwdjfqb · 发表于 2012-2-7 00:56

爱疯发表于 2012-2-7 00:49
仅排序第N列（所选行到N列最后行），会造成记录乱套。建议不使用。

我愿意接受论坛对我的处罚，我以后一定按论坛的规定。

我想起来了，附件6中，既然后以序号列来作为判断，老师以附件6为基础，加一个重新编写序号的语句进去吧，因为排序后序号乱了

爱疯 · 发表于 2012-2-7 01:21

yjwdjfqb 发表于 2012-2-7 00:56
我愿意接受论坛对我的处罚，我以后一定按论坛的规定。

我想起来了，附件6中，既然后以序号列来作为判断 ...

不知我理解对不对，如果说”以附件6为基础，加一个重新编写序号的语句进去...”，那么按科室名先执行的排序，会因序号排序而还原。
对于现在这个问题，你可以只保留很少的记录，但足够说明各种可能的变化。比如保留5行记录和1行表头，共6行。先手动操作看看，能否达到预期效果。如果可以实现，再考虑代码实现。所以，先手动试试看。

yjwdjfqb · 发表于 2012-2-7 08:32

爱疯发表于 2012-2-7 01:21
不知我理解对不对，如果说”以附件6为基础，加一个重新编写序号的语句进去...”，那么按科室名先执行的排 ...

那我就，用手动编号算了。

yjwdjfqb · 发表于 2012-2-7 08:47

爱疯发表于 2012-2-7 01:21
不知我理解对不对，如果说”以附件6为基础，加一个重新编写序号的语句进去...”，那么按科室名先执行的排 ...

这样行不呢！

就是排序完成后，从“序号”下一个单元格从1开始编写序号，编写序号的终止单元格是，当前列最后一个有数据的单元格。

爱疯 · 发表于 2012-2-7 09:15

yjwdjfqb 发表于 2012-2-7 08:47
这样行不呢！

就是排序完成后，从“序号”下一个单元格从1开始编写序号，编写序号的终止单元格是，当前 ...

Sub 科室排序()
Dim arr, i&, j&, c%, r&
'设置自定义排序的顺序
arr = Array("外妇科", "手术室", "内儿科", "西医科", "中医科", "耳鼻喉科", "放射科", "检验科", "B超室", "口腔科", "针灸科", "西药房", "中药房", "收费室", "疾控科", "合管办", "后勤科")
If Not Cells.Find("序号") Is Nothing Then
Set Rng = Cells.Find("序号").CurrentRegion
If Not Intersect(Rng, ActiveCell) Is Nothing Then
With Application
.ScreenUpdating = False
.AddCustomList ListArray:=arr
i = .GetCustomListNum(arr) '返回字符串数组的自定义序列号
c = Rng.Item(1, 1).End(xlToRight).Column '数据源最右侧列号
r = Cells(65536, ActiveCell.Column).End(xlUp).Row '所选单元格所在列最后一个数据的行号
'排序区域
With Range(Cells(ActiveCell.Row, Rng.Column), Cells(r, c))
'设置排序的起始单元格
.Sort key1:=ActiveCell, order1:=xlAscending, _
Header:=xlNo, OrderCustom:=i + 1
End With
'重写序号
For i = ActiveCell.Row + 1 To r '这句不清楚你是否要+1，你自己修改吧
j = j + 1
Cells(i, 1) = j
Next i
.DeleteCustomList ListNum:=i
.ScreenUpdating = True
MsgBox "排序完成", vbInformation
End With
End If
End If
End Sub

复制代码

附件8.rar (21.14 KB, 下载次数: 20)

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

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

RE: 再次求助：VBA＿鼠标选取当前列自定义排序-求修改代码