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

yjwdjfqb

爱疯 发表于 2012-2-6 22:54
c = Range("A1").End(xlToRight).Column
这句作用是确定数据源最右侧在哪一列

那我在A列前加一列，就报错，还有如果我有时想在最左侧空二列，就会出错

yjwdjfqb

爱疯 发表于 2012-2-6 22:54
c = Range("A1").End(xlToRight).Column
这句作用是确定数据源最右侧在哪一列

c = Range("A1").End(xlToRight).Column    '数据源最右侧列号


这一句我明白什么意思了，也很有必要


但为什么，在A列前加一列或几列，会报错。。

爱疯

yjwdjfqb 发表于 2012-2-6 22:58
那我在A列前加一列，就报错，还有如果我有时想在最左侧空二列，就会出错

1. Sub 科室排序()
   
2.     Dim arr, i&, c, r
   
3.     '设置自定义排序的顺序
   
4.     arr = Array("外妇科", "手术室", "内儿科", "西医科", "中医科", "耳鼻喉科", "放射科", "检验科", "B超室", "口腔科", "针灸科", "西药房", "中药房", "收费室", "疾控科", "合管办", "后勤科")
   
5.     With Application
   
6.         .ScreenUpdating = False
   
7.         .AddCustomList ListArray:=arr
   
8.         i = .GetCustomListNum(arr)    '返回字符串数组的自定义序列号
   
9.         c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号
   
10.         r = Cells(65536, ActiveCell.Column).End(xlUp).Row    '所选单元格所在列最后一个数据的行号
    
11.         '排序区域
    
12.         With Range(Cells(ActiveCell.Row, 1), Cells(r, c))
    
13.             '设置排序的起始单元格
    
14.             .Sort key1:=ActiveCell, order1:=xlAscending, _
    
15.                   Header:=xlNo, OrderCustom:=i + 1
    
16.         End With
    
17.         .DeleteCustomList ListNum:=i
    
18.         .ScreenUpdating = True
    
19.         MsgBox "排序完成", vbInformation
    
20.     End With
    
21. End Sub

复制代码

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

2012-2-6 23:05 上传

点击文件名下载附件

yjwdjfqb

爱疯 发表于 2012-2-6 23:05

c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号

如果表头不在第一行，也有问题

我是这样想的，就把IV1改为　　一个表达示　即　当前鼠标所在位置最左侧有数据的单元格

yjwdjfqb

爱疯 发表于 2012-2-6 23:05

c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号

如果表头不在第一行，也有问题

我是这样想的，就把IV1改为　　一个表达示　即　当前鼠标所在行最左侧有数据的单元格

爱疯

yjwdjfqb 发表于 2012-2-6 23:02
c = Range("A1").End(xlToRight).Column    '数据源最右侧列号

因为确定时我是参考的A列的A1，即参考点事A1单元格。
而你说要在A列前插入多列，这样，以A1为参考点的方法就受到影响（出错了）。

参照方法有很多，可根据实际需要调整，以确保在特定条件下正确。

yjwdjfqb

爱疯 发表于 2012-2-6 23:14
因为确定时我是参考的A列的A1，即参考点事A1单元格。
而你说要在A列前插入多列，这样，以A1为参考点的方 ...

c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号

如果表头不在第一行，也有问题

我是这样想的，就把IV1改为　　一个表达示　即　当前鼠标所在行最左侧有数据的单元格

这样的话，全部条件都由鼠标当前所在位置来决定，请老师修改

yjwdjfqb

爱疯 发表于 2012-2-6 23:14
因为确定时我是参考的A列的A1，即参考点事A1单元格。
而你说要在A列前插入多列，这样，以A1为参考点的方 ...

c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号

如果表头不在第一行，也有问题

我是这样想的，就把IV1改为　　一个表达示　即　当前鼠标所在行最左侧有数据的单元格（包括有表格表线的单元格都可以）

这样的话，全部条件都由鼠标当前所在位置来决定，请老师修改

爱疯

yjwdjfqb 发表于 2012-2-6 23:13
c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号

如果表头不在第一行，也有问题

1. 
   
2. Sub 科室排序()
   
3.     Dim arr, i&, c, r
   
4.     '设置自定义排序的顺序
   
5.     arr = Array("外妇科", "手术室", "内儿科", "西医科", "中医科", "耳鼻喉科", "放射科", "检验科", "B超室", "口腔科", "针灸科", "西药房", "中药房", "收费室", "疾控科", "合管办", "后勤科")
   
6.     If Not Cells.Find("序号") Is Nothing Then
   
7.         Set Rng = Cells.Find("序号").CurrentRegion
   
8.         If Not Intersect(Rng, ActiveCell) Is Nothing Then
   
9.             With Application
   
10.                 .ScreenUpdating = False
    
11.                 .AddCustomList ListArray:=arr
    
12.                 i = .GetCustomListNum(arr)    '返回字符串数组的自定义序列号
    
13.                 c = Rng.Item(1, 1).End(xlToRight).Column   '数据源最右侧列号
    
14.                 r = Cells(65536, ActiveCell.Column).End(xlUp).Row    '所选单元格所在列最后一个数据的行号
    
15.                 '排序区域
    
16.                 With Range(Cells(ActiveCell.Row, Rng.Column), Cells(r, c))
    
17.                     '设置排序的起始单元格
    
18.                     .Sort key1:=ActiveCell, order1:=xlAscending, _
    
19.                           Header:=xlNo, OrderCustom:=i + 1
    
20.                 End With
    
21.                 .DeleteCustomList ListNum:=i
    
22.                 .ScreenUpdating = True
    
23.                 MsgBox "排序完成", vbInformation
    
24.             End With
    
25.         End If
    
26.     End If
    
27. End Sub

复制代码

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

2012-2-6 23:27 上传

点击文件名下载附件

yjwdjfqb

爱疯 发表于 2012-2-6 23:27

Sub 科室排序()
    Dim arr, i&, c, r
    '设置自定义排序的顺序
    arr = Array("外妇科", "手术室", "内儿科", "西医科", "中医科", "耳鼻喉科", "放射科", "检验科", "B超室", "口腔科", "针灸科", "西药房", "中药房", "收费室", "疾控科", "合管办", "后勤科")
    With Application
        .ScreenUpdating = False
        .AddCustomList ListArray:=arr
        i = .GetCustomListNum(arr)    '返回字符串数组的自定义序列号
        c = Range("iv1").End(xlToLeft).Column    '数据源最右侧列号
        r = Cells(65536, ActiveCell.Column).End(xlUp).Row    '所选单元格所在列最后一个数据的行号
        '排序区域
        With Range(Cells(ActiveCell.Row, 1), Cells(r, c))
            '设置排序的起始单元格
            .Sort key1:=ActiveCell, order1:=xlAscending, _
                  Header:=xlNo, OrderCustom:=i + 1
        End With
        .DeleteCustomList ListNum:=i
        .ScreenUpdating = True
        MsgBox "排序完成", vbInformation
    End With
End Sub


就用这个
只改这一句好吧                c = Rng.Item(1, 1).End(xlToRight).Column   '数据源最右侧列号

不加那个“序号”的判断