Sub 导入成绩()

    Const TargetSheet = "年级_原始成绩汇总"
Const DesSheet = "年级_本次成绩总表" Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Wb As Workbook, Sht As Worksheet
Dim OpenWb As Workbook, OpenSht As Worksheet
Dim FilePath, FilePaths, SheetName
Dim dGoal As Object
Dim EndRow As Long, EndCol As Long
Dim Arr As Variant
Dim Id As String, Sbj As String, Key As String
Const START_COLUMN As Long = 3
Const START_ROW As Long = 1 Set dGoal = CreateObject("Scripting.Dictionary") '读取外部文件的成绩
FilePaths = PickFilesArr("*.xls*")
If FilePaths(1) <> "NULL" Then
For Each FilePath In FilePaths
'Debug.Print FilePath
Set OpenWb = Application.Workbooks.Open(FilePath)
Set OpenSht = OpenWb.Worksheets(1)
With OpenSht
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
Set Rng = .Range(.Cells(START_ROW, 1), .Cells(EndRow, EndCol))
Arr = Rng.Value
For i = LBound(Arr) + START_ROW To UBound(Arr)
Id = CStr(Arr(i, 1))
For j = LBound(Arr, 2) + START_COLUMN To UBound(Arr, 2)
Sbj = CStr(Arr(1, j))
Key = Id & ";" & Sbj
dGoal(Key) = Arr(i, j)
'Debug.Print Key; " "; Arr(i, j)
Next j
Next i
End With
OpenWb.Close
Next FilePath
Else
MsgBox "未选中任何文件!", vbInformation, "Information"
End If '更新内部
Set Wb = Application.ThisWorkbook
For Each Sht In Wb.Worksheets
If Sht.Name Like "单科成绩_*" Then
With Sht
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
Set Rng = .Range(.Cells(START_ROW, 1), .Cells(EndRow, EndCol))
Arr = Rng.Value
For i = LBound(Arr) + START_ROW To UBound(Arr)
Id = CStr(Arr(i, 1))
For j = LBound(Arr, 2) + START_COLUMN To UBound(Arr, 2)
Sbj = CStr(Arr(1, j))
Key = Id & ";" & Sbj
If dGoal.exists(Key) Then Arr(i, j) = dGoal(Key)
Next j
Next i
Rng.Value = Arr
End With
End If
Next Sht '输出每人每科成绩,缺考的成绩为空
Set Sht = Wb.Worksheets(TargetSheet)
With Sht
.UsedRange.Offset(1, 3).ClearContents
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
For i = START_ROW + 1 To EndRow
Id = .Cells(i, 1).Text
For j = START_COLUMN + 1 To EndCol
Sbj = .Cells(1, j).Text
Key = Id & ";" & Sbj
If dGoal.exists(Key) Then
.Cells(i, j).Value = dGoal(Key)
Else
.Cells(i, j).Value = ""
End If
Next j
Next i '插入排名公式
For j = START_COLUMN + 1 To EndCol
If .Cells(1, j).Value Like "*排" Then
Set Rng = .Range(.Cells(2, j), .Cells(EndRow, j))
Rng.FormulaR1C1 = "=IF(RC[-1]<>"""",RANK(RC[-1],R2C[-1]:R" & EndRow & "C[-1]),"""")"
ElseIf .Cells(1, j).Value = "总分" Then
Set Rng = .Range(.Cells(2, j), .Cells(EndRow, j))
Rng.FormulaR1C1 = "=IF(COUNTA(RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])=9,SUM(RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2]),"""")"
End If
Next j EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
Set Rng = .Range(.Cells(1, 1), .Cells(EndRow, EndCol))
Arr = Rng.Value End With '复制成绩 去除公式 Set oSht = Wb.Worksheets(DesSheet)
With oSht
.Cells.ClearContents
Set Rng = .Range(.Cells(1, 1), .Cells(EndRow, EndCol))
Rng.Value = Arr
SetBorders .UsedRange
SetCenters .UsedRange
.UsedRange.Columns.AutoFit '插入缺考标志
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
.Range("X1").Value = "是否缺考"
If Application.WorksheetFunction.CountA(.Cells(i, 4).Resize(1, 20)) < 20 Then
.Cells(i, "X").Value = "缺考"
End If
Next i
Const STUDENTS = ""
.Range("Y1").Value = "考生类别"
For i = 2 To EndRow
If InStr(STUDENTS, .Cells(i, 2).Value) > 0 Then
.Cells(i, "Y").Value = "其他"
End If
Next i End With Set Sht = Nothing
Set oSht = Nothing
Set Rng = Nothing
Set dGoal = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True End Sub
Function PickFilesArr(Optional FileTypeFilter As String = "", Optional FileNameContain As String = "*", Optional FileNameNotContain As String = "") As String()
Dim FilePath As String
Dim Arr() As String
ReDim Arr(1 To 1)
Dim FileCount As Long
Dim i As Long
FileCount = 0
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = Application.ActiveWorkbook.Path
.Title = "请选择你需要的文件"
.Filters.Clear
If Len(FileTypeFilter) > 0 Then
.Filters.Add "您需要的文件类型", FileTypeFilter
End If
If .Show = -1 Then
Arr(1) = "NULL"
For i = 1 To .SelectedItems.Count
If .SelectedItems(i) Like FileNameContain Then
If Len(FileNameNotContain) = 0 Then
FileCount = FileCount + 1
ReDim Preserve Arr(1 To FileCount)
Arr(FileCount) = .SelectedItems(i)
Debug.Print Arr(FileCount)
Else
If Not .SelectedItems(i) Like FileNameNotContain Then
FileCount = FileCount + 1
ReDim Preserve Arr(1 To FileCount)
Arr(FileCount) = .SelectedItems(i)
End If
End If
End If
Next i
PickFilesArr = Arr
Else
'MsgBox "Pick no file!"
Arr(1) = "NULL"
PickFilesArr = Arr
Exit Function
End If
End With
End Function

  

20181013xlVba导入成绩的更多相关文章

  1. 20181013xlVba年级成绩报表

    Public Sub 高一成绩报表() Application.ScreenUpdating = False Application.DisplayAlerts = False Application ...

  2. 20181013xlVba据成绩条生成图片文件

    Sub CreateGoalPictures() '声明变量 Dim Wb As Workbook Dim Sht As Worksheet Dim Shp As Shape Dim Pic, End ...

  3. .Net之路(十三)数据库导出到EXCEL

    .NET中导出到Office文档(word,excel)有我理解的两种方法.一种是将导出的文件存放在server某个目录以下,利用response输出到浏览器地址栏,直接打开:还有直接利用javasc ...

  4. .Net路(十三)导出数据库到EXCEL

    .NET出口Office文件(word,excel)有两种方法我明白.一个存储在导出的文件中server录以下.利用response输出到浏览器地址栏,直接打开:还有直接利用javascript来导出 ...

  5. 20181013xlVba成绩报表优化

    Public Sub 成绩报表优化() Application.ScreenUpdating = False Application.DisplayAlerts = False Application ...

  6. C# Excel导入、导出【源码下载】

    本篇主要介绍C#的Excel导入.导出. 目录 1. 介绍:描述第三方类库NPOI以及Excel结构 2. Excel导入:介绍C#如何调用NPOI进行Excel导入,包含:流程图.NOPI以及C#代 ...

  7. [转]Java中导入、导出Excel

    原文地址:http://blog.csdn.net/jerehedu/article/details/45195359 一.介绍 当前B/S模式已成为应用开发的主流,而在企业办公系统中,常常有客户这样 ...

  8. java的poi技术读取和导入Excel

    项目结构: http://www.cnblogs.com/hongten/gallery/image/111987.html  用到的Excel文件: http://www.cnblogs.com/h ...

  9. 从零自学Hadoop(16):Hive数据导入导出,集群数据迁移上

    阅读目录 序 导入文件到Hive 将其他表的查询结果导入表 动态分区插入 将SQL语句的值插入到表中 模拟数据文件下载 系列索引 本文版权归mephisto和博客园共有,欢迎转载,但须保留此段声明,并 ...

随机推荐

  1. Oracle错误——SP2-0734: 未知的命令开头 "imp C##sin..." - 忽略了剩余的行。

    错误 在windows的DOS窗口下使用命令导入Oracle数据. 原因 进入sqlplus里是不能执行imp的(sqlplus不认识imp),imp 是个工具,应该在cmd的dos命令提示符下执行.

  2. maven项目出现红色感叹号报错

    背景 在eclipse部署maven项目的时候,项目出现红色的感叹号导致项目无法启动. 解决步骤 1.右键项目——>Maven——>Update Project ,弹出下框: 点击OK. ...

  3. Bootstrap3基础 img-responsive 响应式图片

      内容 参数   OS   Windows 10 x64   browser   Firefox 65.0.2   framework     Bootstrap 3.3.7   editor    ...

  4. Bootstrap3基础 form-control 圆角的输入框,光标放入后边框变色

      内容 参数   OS   Windows 10 x64   browser   Firefox 65.0.2   framework     Bootstrap 3.3.7   editor    ...

  5. sqlserver无法在数据库上放置锁

    由于无法在数据库 ' ' 上放置锁,ALTER DATABASE 失败.请稍后再试.消息5069,级别16,状态1,第一行ALTER DATABASE 语句失败. 解决方法: 新建查询,通过下面SQL ...

  6. 【定制Android系统】Android O 在ROM中添加自己的 so 库(1)——Android.mk 与 Android.bp 的区别【转】

    本文转载自: 版权声明:本文为博主原创文章,转载时请注明原作者及出处.    https://blog.csdn.net/u014248312/article/details/82020204需求:在 ...

  7. hdfoo站点开发笔记

    为了安全,也要兼顾编辑器切换管理 开发时不必管目录名称的事, 只是在部署的时候,才修改应用目录和tp目录的名字就行了. 为了提高tp的加载效率, 始终给app和tp以绝对路径.就是以 realpath ...

  8. 【C#】委托的发展

    "用事件去处理程序, 进而解决问题" ---- 委托的目的 委托早在C#2的时候就已经初具模型, 但是并不是特别灵活, 制止C#3才在代码中被广泛使用. C#4中泛型委托, C#5 ...

  9. codeforce gym/100495/problem/F Snake++——DFS应用

    emmmm.... 在被新生暴打后,我花了很久才补出这道DFS.由于WA1检查了半天,最后竟然是输出少了一个:   ,心态小崩. 这里普通的dfs算出的连通区域并不能直接当做最后的答案.所以需要类似模 ...

  10. Webpack+React项目入门——入门及配置Webpack

    一.入门Webpack 参考文章:<入门Webpack,看这篇就够了> 耐心看完这篇非常有帮助 二.React+Webpack环境配置 参考文章:<webpack+react项目初体 ...