VBA实例:高考分数投档指数分析(备选院校页)
2020-09-02 23:38
2691 查看
'当前页:ThisWorkbook.Worksheets("备选院校")
Sub 清除数据总() If ThisWorkbook.Worksheets("排除院校列表").range("B2") <> "" Then Dim YN As Integer YN = MsgBox(prompt:="重要提示:排除院校列表尚存记录,这些院校记录将不会被本次检索出来,如该数据不是正确记录,请及时删除!", Title:="提示!") End If range("A5:AG500").ClearContents Call 初始数据 End Sub Sub 清除数据() range("O2") = "" range("Q2") = "" range("J2") = "" range("AC2") = "" range("AE2") = "" range("AG2") = "" End Sub
Sub 排除院校() Dim I% Dim rngs As range, cell As range I = Selection.Row If I > 4 Then Selection.EntireRow.Select Intersect(Selection, range("C:D")).Select Set rngs = Selection Set cell = ThisWorkbook.Worksheets("排除院校列表").[B500].End(xlUp)(2, 1) rngs.Copy cell Selection.EntireRow.Select Selection.ClearContents [A1].Select [AA2] = 返回学校记录数() Call 记录排序 End If End Sub
Sub 初始数据() [H3] = [B2] - 1 [L3] = [B2] - 2 [P3] = [B2] - 3 [j2] = 查省排名([H2], [B2], [L2]) [o2] = 查投档线([D2], [B2], [L2]) [Q2] = [H2] - [o2] [ac2] = 查同排名分数([j2], [H3], [L2]) [ae2] = 查同排名分数([j2], [L3], [L2]) [ag2] = 查同排名分数([j2], [P3], [L2]) End Sub
Sub 搜索学校() Call 清除数据 Call 初始数据 Call 搜上1年 MsgBox "搜索完毕!" End Sub
Sub 补充数据() range("I5:K500").ClearContents range("M5:O500").ClearContents range("Q5:S500").ClearContents Call 填资料 Call 填数据(1) Call 填数据(2) Call 填数据(3) If [B2] < "2020" Then Call 填数据(4) End If Call 记录排序 MsgBox "补充数据完毕!" End Sub
Sub 搜上1年() Dim I%, J% Dim rng As range, rng1 As range, rng2 As range I = 返回学校记录数() + 1 For Each rng1 In ThisWorkbook.Worksheets("院校投档分数线").range("B2", ThisWorkbook.Worksheets("院校投档分数线").[B2].End(xlDown)) If rng1 = [H3] And InStr(rng1(1, 4), Mid([L2], 1, 1)) > 0 And rng1(1, 2) = [D2] Then '年,科类, If 返回学校代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 And 返回排除代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 Then If rng1(1, 7) >= [j2] + [U2] And rng1(1, 7) <= [j2] + [V2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7) = Int(rng1(1, 6)) range("C5")(I, 8) = rng1(1, 8) range("C5")(I, 9) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 Else If rng1(1, 8) <= [Q2] + [X2] And rng1(1, 8) >= [Q2] + [y2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7) = Int(rng1(1, 6)) range("C5")(I, 8) = rng1(1, 8) range("C5")(I, 9) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 End If End If Else range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7) = Int(rng1(1, 6)) range("C5")(I, 8) = rng1(1, 8) End If End If End If Else range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7) = Int(rng1(1, 6)) range("C5")(I, 8) = rng1(1, 8) range("C5")(I, 9) = rng1(1, 7) [AA2] = I - 1 End If Next rng1 range("C5")(I, 2) = "" range("C5")(I, 7) = "" range("C5")(I, 8) = "" range("C5")(I, 9) = "" Call 搜上2年(I) End Sub
Sub 搜上2年(row_s As Variant) I = row_s For Each rng1 In ThisWorkbook.Worksheets("院校投档分数线").range("B2", ThisWorkbook.Worksheets("院校投档分数线").[B2].End(xlDown)) If rng1 = [L3] And InStr(rng1(1, 4), Mid([L2], 1, 1)) > 0 And rng1(1, 2) = [D2] Then If 返回学校代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 And 返回排除代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 Then If rng1(1, 7) >= [j2] + [U2] And rng1(1, 7) <= [j2] + [V2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 4) = Int(rng1(1, 6)) range("C5")(I, 8 + 4) = rng1(1, 8) range("C5")(I, 9 + 4) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 Else If rng1(1, 8) <= [Q2] + [X2] And rng1(1, 8) >= [Q2] + [y2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 4) = Int(rng1(1, 6)) range("C5")(I, 8 + 4) = rng1(1, 8) range("C5")(I, 9 + 4) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 End If End If End If Else range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 4) = Int(rng1(1, 6)) range("C5")(I, 8 + 4) = rng1(1, 8) range("C5")(I, 9 + 4) = rng1(1, 7) [AA2] = I - 1 End If Next rng1 range("C5")(I, 2) = "" range("C5")(I, 7 + 4) = "" range("C5")(I, 8 + 4) = "" range("C5")(I, 9 + 4) = "" Call 搜上3年(I) End Sub
Sub 搜上3年(row_s As Variant) Dim I%, J% Dim rng As range, rng1 As range, rng2 As range I = row_s For Each rng1 In ThisWorkbook.Worksheets("院校投档分数线").range("B2", ThisWorkbook.Worksheets("院校投档分数线").[B2].End(xlDown)) If rng1 = [P3] And InStr(rng1(1, 4), Mid([L2], 1, 1)) > 0 And rng1(1, 2) = [D2] Then If 返回学校代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 And 返回排除代码(Trim(rng1(1, 3)), Trim(rng1(1, 5))) = 0 Then If rng1(1, 7) >= [j2] + [U2] And rng1(1, 7) <= [j2] + [V2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 8) = Int(rng1(1, 6)) range("C5")(I, 8 + 8) = rng1(1, 8) range("C5")(I, 9 + 8) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 Else If rng1(1, 8) <= [Q2] + [X2] And rng1(1, 8) >= [Q2] + [y2] Then range("C5")(I, 1) = rng1(1, 3) range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 8) = Int(rng1(1, 6)) range("C5")(I, 8 + 8) = rng1(1, 8) range("C5")(I, 9 + 8) = rng1(1, 7) range("C5")(I, -1) = rng1(1, 2) I = I + 1 End If End If End If Else range("C5")(I, 2) = rng1(1, 5) range("C5")(I, 7 + 8) = Int(rng1(1, 6)) range("C5")(I, 8 + 8) = rng1(1, 8) range("C5")(I, 9 + 8) = rng1(1, 7) [AA2] = I - 1 End If Next rng1 range("C5")(I, 2) = "" range("C5")(I, 7 + 8) = "" range("C5")(I, 8 + 8) = "" range("C5")(I, 9 + 8) = "" End Sub
Sub 填资料() Call 初始数据 Dim rng As range, rng1 As range For Each rng In ThisWorkbook.Worksheets("备选院校").range("C5", ThisWorkbook.Worksheets("备选院校").[C5].End(xlDown)) If rng(1, 2) = "" Then For Each rng1 In ThisWorkbook.Worksheets("院校投档分数线").range("D2", ThisWorkbook.Worksheets("院校投档分数线").[D2].End(xlDown)) If rng = rng1 And [D2] = rng1(1, 0) And InStr(rng1(1, 2), Mid([L2], 1, 1)) > 0 Then rng(1, 2) = rng1(1, 3) Exit For End If Next rng1 End If rng(1, -1) = [D2] rng(1, 0) = 返回重点学校(rng) If rng(1, 0) = "" Then rng(1, 0) = 返回学校评级(rng) End If If rng(1, 0) = "" Then rng(1, 0) = " " End If Next rng End Sub
Sub 填数据(type_s As Variant) Dim rng As range, rng1 As range For Each rng In ThisWorkbook.Worksheets("备选院校").range("C5", ThisWorkbook.Worksheets("备选院校").[C5].End(xlDown)) For Each rng1 In ThisWorkbook.Worksheets("院校投档分数线").range("D2", ThisWorkbook.Worksheets("院校投档分数线").[D2].End(xlDown)) If rng(1, 2) = rng1(1, 3) And Trim(rng) = Trim(rng1) And [D2] = rng1(1, 0) And InStr(rng1(1, 2), Mid([L2], 1, 1)) > 0 Then If rng1(1, -1) = [H3] And type_s = 1 Then '本年 rng(1, 7) = Int(rng1(1, 4)) rng(1, 8) = Int(rng1(1, 6)) rng(1, 9) = Int(rng1(1, 5)) End If If rng1(1, -1) = [L3] And type_s = 2 Then '去年 rng(1, 11) = Int(rng1(1, 4)) rng(1, 12) = Int(rng1(1, 6)) rng(1, 13) = Int(rng1(1, 5)) End If If rng1(1, -1) = [P3] And type_s = 3 Then '前年 rng(1, 15) = Int(rng1(1, 4)) rng(1, 16) = Int(rng1(1, 6)) rng(1, 17) = Int(rng1(1, 5)) End If If rng1(1, -1) = [B2] And type_s = 4 Then '当年 If ThisWorkbook.Worksheets("备选院校").[H2] >= Int(rng1(1, 4)) Then rng(1, 19) = "投档" & Int(rng1(1, 4)) Else rng(1, 19) = Int(rng1(1, 4)) End If End If If rng1(1, -1) = [B2] And type_s = 5 Then '当年 If ThisWorkbook.Worksheets("备选院校").[H2] >= Int(rng1(1, 4)) Then rng(1, 19) = "投档" & Int(rng1(1, 4)) Else rng(1, 19) = Int(rng1(1, 4)) End If End If End If Next rng1 Next rng End Sub
Sub 投档指数() Dim I, J, xc, pm Dim rng As range, rng1 As range xc = [Q2] pm = [j2] For Each rng In ThisWorkbook.Worksheets("备选院校").range("C5", ThisWorkbook.Worksheets("备选院校").[C5].End(xlDown)) I = xc - (rng(1, 8) + rng(1, 12) + rng(1, 16)) / 返回历史数据(rng.Row) + 50 J = ((rng(1, 9) + rng(1, 13) + rng(1, 17)) / 返回历史数据(rng.Row) - pm) / 10 + 50 rng(1, 18) = (I + J) / 10 Next rng If 返回院校投档数据([D2], [B2], [L2]) = 1 Then Call 填数据(5) End If Call 投档排序 End Sub
相关文章推荐
- VBA实例:高考分数投档指数分析(表格模板)
- 上海历届高考分数参谋以及专家分析
- VBA代码实例---根据分数判断等级
- 浙江省2009年高考文理科第二批院校平行志愿首轮投档分数线
- i2c设备驱动实例分析-pca9541(上)
- python GUI库图形界面开发之PyQt5简单绘图板实例与代码分析
- python编程进阶之异常处理用法实例分析
- UE4反射系统简析(含实例过程分析)
- fork实例分析
- binder 实例分析
- 实例讲解木马的分析方法
- python面试题之列表声明实例分析
- PHP PDO和消息队列的个人理解与应用实例分析
- 索引原理及项目中如何使用索引实例分析
- spring boot validation参数校验实例分析
- Hadoop 实例1---通过采集的气象数据分析每年的最高温度
- Hive学习之路 (二十)Hive 执行过程实例分析
- C语言实现CRC算法实例分析
- 结构体变量、结构指针变量、结构数组作为函数的参数应用实例分析
- 基于ArcGIS API for WPF路径分析源码实例