国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

Attribute VB_Name = "模塊1"
Public classCount As Integer
Public sheetName As String
'作者  Xian云
'日期  2018-5-3
'程序非萬能，必要請手動
'若工作表處于保護(hù)狀態(tài)，則程序無法讀取并修改，請取消保護(hù)并保存，以使用此程序
Sub 成績統(tǒng)計自動化()
    '以下兩行代碼為了提高運(yùn)算速度，暫時關(guān)閉掉屏幕上的效果顯示,計算結(jié)束后恢復(fù)
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim sql As String
    Dim className As String
    sheetName = InputBox("請輸入要統(tǒng)計的表的名字（如sheet1）", "需要您的輸入")
    classCount = Val(InputBox("請輸入班級總數(shù)", "需要您的輸入"))
'   sheetName = "1次月考總成績"
'   classCount = 16
    Dim i As Integer
    For i = 1 To classCount
        className = i & "班"
        sql = "select * from [" + sheetName + "$] where 班級 = """ & className & """" + "order by 總分 desc"
        Call sqlExe(sql, className)
        scoreCalc (className)
    Next
    '恢復(fù)屏幕顯示，恢復(fù)計算
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
End Sub
'統(tǒng)計指定表的成績并返回
Function scoreCalc(table As String)
    '若考試科目增加或修改，只需要修改下面的數(shù)組中的科目信息,注意英文引號及逗號
    classNames = Array("語文", "數(shù)學(xué)", "英語", "思品", "歷史", "地理", "生物")
    Dim name As String
    Dim flg As Boolean
    Dim col As Integer, row As Integer, getIndex As Integer, Count As Integer
    Dim i As Integer, j As Integer
    col = ActiveWorkbook.Worksheets(table).UsedRange.Columns.Count
    row = ActiveWorkbook.Worksheets(table).UsedRange.Rows.Count
    flg = True
    Count = 0
    For i = 1 To col
        name = ActiveWorkbook.Worksheets(table).UsedRange.Cells(1, i)
        getIndex = -1
        '找到成績列
        For j = 0 To 6
            If classNames(j) = name Then
                getIndex = j
                Exit For
            End If
        Next j
        If getIndex <> -1 Then
            Call colWidth(i, 5)
            If flg Then
                Call setTitle(table, i, row, "平均分")
                Call setTitle(table, i, row + 1, "及格率")
                Call setTitle(table, i, row + 2, "優(yōu)秀率")
                flg = False
            End If
            Call setAvg(table, i, row)
            Call setPassing(table, i, row + 1)
            Call setExcellent(table, i, row + 2)
        Else
            If name = "班級" Then Call colWidth(i, 4.25)
            If name = "考號" Then Call colWidth(i, 11.5)
            If name = "序號" Then Call colWidth(i, 3.75)
            If name = "姓名" Then Call colWidth(i, 7.5)
            If name = "總分" Then Call colWidth(i, 4.13)
            If name = "校名次" Then Call colWidth(i, 6)
        End If
    Next i
End Function
'設(shè)置第i列的寬度
Sub colWidth(ByVal i As Integer, ByVal width As Single)
    ColumnName = Chr(i + Asc("A") - 1)
    Columns(ColumnName & ":" & ColumnName).Select
    Selection.ColumnWidth = width
End Sub
Sub setTitle(table As String, ByVal i As String, row As Integer, ByVal title As String)
    c = Chr(i + Asc("A") - 2)
    Range(c & (row + 1)).Select
    Application.Worksheets(table).Range(c & (row + 1)).Clear
    Application.Worksheets(table).Range(c & (row + 1)).FormulaR1C1 = title
End Sub
'根據(jù)sql語句查詢，并將結(jié)果返回，sql語句的結(jié)果須為一個整型值
Function setAvg(table As String, ByVal i As String, row As Integer) As Integer
    c = Chr(i + Asc("A") - 1)
    Range(c & (row + 1)).Select
    sss = "=AVERAGE(R[" & (1 - row) & "]C:R[-1]C)"
     '   ActiveCell.FormulaR1C1 = "=AVERAGE(R[-59]C:R[-1]C)"
    Application.Worksheets(table).Range(c & (row + 1)).Clear
    Application.Worksheets(table).Range(c & (row + 1)).FormulaR1C1 = sss
    Selection.NumberFormatLocal = "0.00_ "
End Function
'計算及格率并填入表格
Function setPassing(table As String, ByVal i As String, row As Integer) As Integer
    c = Chr(i + Asc("A") - 1)
    Range(c & (row + 1)).Select
    sss = "=COUNTIF(R[" & (1 - row) & "]C:R[-2]C,"">=60"")/COUNT(R[" & (1 - row) & "]C:R[-2]C)"
    Application.Worksheets(table).Range(c & (row + 1)).Clear
    Selection.NumberFormatLocal = "0.000_ "
    Application.Worksheets(table).Range(c & (row + 1)).FormulaR1C1 = sss
End Function
'
'計算優(yōu)秀率并填入表格
Function setExcellent(table As String, ByVal i As String, row As Integer) As Integer
    c = Chr(i + Asc("A") - 1)
    Range(c & (row + 1)).Select
    sss = "=COUNTIF(R[" & (1 - row) & "]C:R[-3]C,"">=80"")/COUNT(R[" & (1 - row) & "]C:R[-3]C)"
     '   ActiveCell.FormulaR1C1 = "=AVERAGE(R[-59]C:R[-1]C)"
    Application.Worksheets(table).Range(c & (row + 1)).Clear
    Selection.NumberFormatLocal = "0.000_ "
    Application.Worksheets(table).Range(c & (row + 1)).FormulaR1C1 = sss
End Function
'完成查詢功能并新建工作表保存，sql為查詢語句
Sub sqlExe(sql As String, table As String)
    Dim cnn As Object, rs As Object
    Set cnn = CreateObject("adodb.connection")          '創(chuàng)建數(shù)據(jù)庫連接
    cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ActiveWorkbook.FullName
    Set rs = CreateObject("adodb.recordset") '創(chuàng)建一個數(shù)據(jù)集
    Set rs = cnn.Execute(sql) '執(zhí)行查詢
    Sheets.Add.name = table
    ActiveWorkbook.Worksheets(table).Cells.ClearContents
    Dim i As Integer
    For i = 1 To rs.Fields.Count - 1
        ActiveWorkbook.Worksheets(table).Cells(1, i) = rs.Fields(i - 1).name '填寫標(biāo)題到指定表
    Next
    ActiveWorkbook.Worksheets(table).Range("a2").CopyFromRecordset rs '復(fù)制記錄集到指定表
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub