[已解决]谢谢阿童木老师，动态标准排序

lhj323323

X1EN0KFA.rar (126.29 KB, 下载次数: 14)

2010-6-9 10:06 上传

点击文件名下载附件
[求助]动态标准排序
老师：

上传附件中有详细的说明，请看看，谢谢了

[此贴子已经被作者于2010-6-9 21:41:55编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-6-9 10:28

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'用户在的[C1：H1]区间双击任意一个单元格，电脑将对该单元格所在的列进行有标题行的降序排列

If Target.Count > 1 Then Exit Sub '如果单元格个数超过1个，则退出程序
If Target.Row <> 1 Then Exit Sub '如果单元格行数不在第一行，则退出程序
If Target.Column > 8 Or Target.Column < 3 Then
    Cells.Interior.ColorIndex = xlNone
    Exit Sub '第3列到第8列之间的数据
End If
'有标题行一个条件降序排序
Dim Myr&
Dim Sht1 As Worksheet
Set Sht1 = ThisWorkbook.Worksheets("B")
Application.ScreenUpdating = False
Cancel = True
Cells.Interior.ColorIndex = xlNone
Target.Interior.Color = RGB(0, 0, 255)
Myr = Sht1.[a65536].End(xlUp).Row
Sht1.Range("a1:h" & Myr).Sort Key1:=Sht1.Cells(1, Target.Column), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin ', DataOption1:=xlSortNormal  '加这一句电脑就会提示"应用程序定义或对象定义错误"
         
         
Application.ScreenUpdating = True

'End If
End Sub

跳转到最佳答案楼层

amulee

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'用户在的[C1：H1]区间双击任意一个单元格，电脑将对该单元格所在的列进行有标题行的降序排列

If Target.Count > 1 Then Exit Sub '如果单元格个数超过1个，则退出程序
If Target.Row <> 1 Then Exit Sub '如果单元格行数不在第一行，则退出程序
If Target.Column > 8 Or Target.Column < 3 Then
    Cells.Interior.ColorIndex = xlNone
    Exit Sub '第3列到第8列之间的数据
End If
'有标题行一个条件降序排序
Dim Myr&
Dim Sht1 As Worksheet
Set Sht1 = ThisWorkbook.Worksheets("B")
Application.ScreenUpdating = False
Cancel = True
Cells.Interior.ColorIndex = xlNone
Target.Interior.Color = RGB(0, 0, 255)
Myr = Sht1.[a65536].End(xlUp).Row
Sht1.Range("a1:h" & Myr).Sort Key1:=Sht1.Cells(1, Target.Column), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin ', DataOption1:=xlSortNormal  '加这一句电脑就会提示"应用程序定义或对象定义错误"
         
         
Application.ScreenUpdating = True

'End If
End Sub

cyj153

QUOTE:

以下是引用amulee在2010-6-9 10:28:00的发言：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'用户在的[C1：H1]区间双击任意一个单元格，电脑将对该单元格所在的列进行有标题行的降序排列

If Target.Count > 1 Then Exit Sub '如果单元格个数超过1个，则退出程序
If Target.Row <> 1 Then Exit Sub '如果单元格行数不在第一行，则退出程序
If Target.Column > 8 Or Target.Column < 3 Then
    Cells.Interior.ColorIndex = xlNone
    Exit Sub '第3列到第8列之间的数据
End If
'有标题行一个条件降序排序
Dim Myr&
Dim Sht1 As Worksheet
Set Sht1 = ThisWorkbook.Worksheets("B")
Application.ScreenUpdating = False
Cancel = True
Cells.Interior.ColorIndex = xlNone
Target.Interior.Color = RGB(0, 0, 255)
Myr = Sht1.[a65536].End(xlUp).Row
Sht1.Range("a1:h" & Myr).Sort Key1:=Sht1.Cells(1, Target.Column), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin ', DataOption1:=xlSortNormal  '加这一句电脑就会提示"应用程序定义或对象定义错误"
         
         
Application.ScreenUpdating = True

'End If
End Sub

如果，C、D列以升序排序；E、F、G、H列以降序排列又该这么办呢？