VBA实例：高考分数投档指数分析（备选院校页）

2021-03-29 18:25

阅读：764

标签：tle end str 初始历史 range 搜索 sheet prompt

‘当前页：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]


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) = [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) = [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) = [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实例：高考分数投档指数分析（备选院校页）

标签：tle end str 初始历史 range 搜索 sheet prompt

原文地址：https://blog.51cto.com/12815848/2527928

上一篇：Python合并字典组成的列表

下一篇：Spring Security 实战干货：基于注解的接口角色访问控制

文章来自：搜素材网的编程语言模块，转载请注明文章出处。
文章标题：VBA实例：高考分数投档指数分析（备选院校页）
文章链接：http://soscw.com/index.php/essay/69624.html

亲，登录后才可以留言！

VBA实例：高考分数投档指数分析（备选院校页）

评论

热门文章

推荐文章

最新文章

置顶文章