登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

胡益兵的博客

新的岗位,新的方向,新的使命,stem教育进行中。

 
 
 

日志

 
 

用VBA实现运动会的成绩录入与排序问题  

2011-09-29 14:30:11|  分类: 技术文锦 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

学校要开运动会,提出运动会也要信息化,要求成绩的录入、发布、排名和奖状发放都要利用计算机完成。我花了一周的业余时间在一个excel表中实现了按赛项筛选录入和按赛项自动排序功能。

代码如下:

Private Sub CommandButton2_Click()

'按下拉列表筛选(要提前用高级筛选做好赛项的下拉列表)
    Range("A1:K607").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("M1:M2"), Unique:=False

End Sub

Private Sub 排序排名_Click()
'
' 排序 Macro
' Order:=xlAscending 升序
'Order:=xlDescending 降序


'先按赛项排序,赛项相同的按照成绩排序

    ActiveWorkbook.Worksheets("径赛").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("径赛").Sort.SortFields.Add Key:=Range("C2:C823") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("径赛").Sort.SortFields.Add Key:=Range("H2:H823") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("径赛").Sort
        .SetRange Range("A1:K823")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'以下分段排序,先清除原来的排序信息
For j = 2 To 823
Sheet2.Range("i" & j) = ""
Next
i = 0
For j = 2 To 823
'判断相邻的两行是不是同一个比赛项目,如果是同一个比赛项目且没有达到该项目的设奖数目,则给改行设奖

If (Sheet2.Range("c" & j) = Sheet2.Range("c" & j + 1) And Sheet2.Range("f" & j) > i) Or (Sheet2.Range("c" & j) <> Sheet2.Range("c" & j + 1) And Sheet2.Range("f" & j) > i) Then
i = i + 1
Sheet2.Range("i" & j) = i
End If
If Sheet2.Range("c" & j) <> Sheet2.Range("c" & j + 1) Then
i = 0
End If
Next
End Sub

Private Sub 全显_Click()

'取消筛选
ActiveSheet.ShowAllData
End Sub

  评论这张
 
阅读(238)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018