按条件提取前N名的问题：1.含0.5分的数据未提取。 2.提取表存在时运行程序出错。

game178

1.含0.5分的数据未提取。2.提取表存在时运行程序出错。（提取表由程序生成）


自己还不怎么会VBA，目前正在摸索中，这个是借鉴别人的修改内容。请大神帮忙


Sub 提取前N名()
Application.ScreenUpdating = False
Dim dc As Object, arr, i&, x&, j%, k%, s&, c%, aa$, bb%
Set dc = CreateObject("scripting.dictionary")
With Sheets("成绩表")
x = .Cells(Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:q" & x) '数据源范围
End With

'arr 数据源  brr输出表
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
     aa = Sheets("设置").Range("S2")  '提取的对象
     bb = Sheets("设置").Range("S3")   'N的大小


    For j = 6 To UBound(arr, 2) '从语文科目开始分列查找
    m = arr(1, j)
        If m = aa Then c = j
    Next
    For j = 750 To 1 Step -1   '分数查找范围 为了把总分加进来，从750分开始倒查
        For i = 1 To UBound(arr)
        sj = arr(i, c)  '显示数据
            If Len(sj) > 0 And sj = j Then
               dc(arr(i, c)) = ""
               If dc.Count = bb + 1 Then GoTo 100
               s = s + 1  '符合条件的学生计数
               For k = 1 To UBound(arr, 2) '开始创建关键字存入字典
                   brr(s, k) = arr(i, k)
               Next
            End If
        Next
    Next

100
Call 创建提取表

With Sheets("提取前N名")
.Range("a1:z65536").ClearContents

.Range("a1") = "学校"
.Range("b1") = "班级"
.Range("c1") = "科类"
.Range("d1") = "姓名"
.Range("e1") = "考号"

.Range("f1") = "语文"
.Range("g1") = "数学"
.Range("h1") = "英语"

.Range("i1") = "物理"
.Range("j1") = "化学"
.Range("k1") = "生物"

.Range("l1") = "政治"
.Range("m1") = "历史"
.Range("n1") = "地理"

.Range("o1") = "总分"
.Range("p1") = "班名"
.Range("q1") = "级名"


.Range("s1") = "共" & s & " 人"
.Range("a2").Resize(s, UBound(arr, 2)) = brr
r = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range("a2").Resize(s, UBound(arr, 2)).Borders.LineStyle = xlContinuous

     Sheets("提取前N名").UsedRange.Sort key1:=Range("c1"), order1:=xlDescending, Header:=1  '将数据按科类升序，次按总分降序排列

End With
Application.ScreenUpdating = True
End Sub

Sub 创建提取表()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = "提取前N名" Then Exit Sub
Next
Set sh = Sheets.Add(after:=Worksheets("设置"))
sh.Name = "提取前N名"
End Sub

game178

对第2个问题，目前的想法是在运行前加载一个删除提取表指令


Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name = "提取前N名" Then sh.Delete   
Next


有更好的办法吗？

game178

目前的问题是：比如想提取总分前10名，结果凡是总分中含有0.5的（比如478.5  453.5......）都没有提取出来，只提取了整数值。

困惑中，希望大神帮忙看看，指点一下。谢谢

另：如果我想提取指定分数以上的又该怎么写，如提取总分（S5单元格指定，可变）在420分以上（S6单元格指定，可变）的数据

game178

如果把步长定为0.5的话：

For j = 750 To 1 Step -0.5   '分数查找范围 为了把总分加进来，从750分开始倒查

前面到是没问题，可是下面这个地方出问题了。（好像是S为0）
.Range("s1") = "共" & s & " 人"
.Range("a2").Resize(s, UBound(arr, 2)) = brr

game178

自己顶上去，大家帮忙看看

game178

貌似发错地方了，见谅见谅。封闭楼层。