|
- Option Explicit
- Dim objItem As Object, objResult As Object
- Dim arrBoy_Jump As Variant, arrBoy_Ball As Variant, arrBoy_Rope As Variant, arrBoy_SitUp As Variant, arrBoy_Result As Variant
- Dim arrGril_Jump As Variant, arrGril_Ball As Variant, arrGril_Rope As Variant, arrGril_SitUp As Variant, arrGril_Result As Variant
- Sub Test()
- Dim SH As Worksheet
- Dim arrTemp As Variant, lngRow As Long
- Dim strSex As String, strItem As String
-
- SetInfo '初始化
-
- Set SH = Sheets("Sheet1")
- lngRow = SH.Range("A" & Rows.Count).End(xlUp).Row
- arrTemp = SH.Range("A2:I" & lngRow)
-
- For lngRow = LBound(arrTemp) To UBound(arrTemp)
- strSex = Trim(arrTemp(lngRow, 1)) '性别
- strItem = Trim(arrTemp(lngRow, 2)) '项目
-
- Select Case UCase(Trim(strItem))
- Case "A" 'A类 立定跳远 前掷实心球
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Jump-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("Ball-" & strSex), objResult(strSex))
- Case "B" 'B类 立定跳远 一分钟跳绳
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Jump-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("Rope-" & strSex), objResult(strSex))
- Case "C" 'C类 立定跳远 一分钟仰卧起坐
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Jump-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("SitUp-" & strSex), objResult(strSex))
- Case "D" 'D类 前掷实心球 一分钟跳绳
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Ball-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("Rope-" & strSex), objResult(strSex))
- Case "E" 'E类 前掷实心球 一分钟仰卧起坐
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Ball-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("SitUp-" & strSex), objResult(strSex))
- Case "F" 'F类 一分钟跳绳 一分钟仰卧起坐
- arrTemp(lngRow, 7) = GetInfo(Val(arrTemp(lngRow, 6)), objItem("Rope-" & strSex), objResult(strSex))
- arrTemp(lngRow, 9) = GetInfo(Val(arrTemp(lngRow, 8)), objItem("SitUp-" & strSex), objResult(strSex))
- End Select
- Next
-
- SH.Range("A2").Resize(UBound(arrTemp), 9) = arrTemp
- End Sub
- Function GetInfo(dblVal As Double, arrFind As Variant, arrResult As Variant) As String
- If dblVal = 0 Then
- GetInfo = ""
- Else
- GetInfo = Application.WorksheetFunction.Lookup(dblVal, arrFind, arrResult)
- End If
- End Function
- Function SetInfo()
- Dim SH_Boy As Worksheet, SH_Gril As Worksheet
- Dim arrTemp As Variant, lngRow As Long, lngID As Long
-
- Set SH_Boy = Sheets("男生")
- Set SH_Gril = Sheets("女生")
-
- '男生数据初始化
- arrTemp = SH_Boy.Range("A2:E22")
- lngRow = UBound(arrTemp)
- ReDim arrBoy_Jump(0 To lngRow) As Double
- ReDim arrBoy_Ball(0 To lngRow) As Double
- ReDim arrBoy_Rope(0 To lngRow) As Double
- ReDim arrBoy_SitUp(0 To lngRow) As Double
- ReDim arrBoy_Result(0 To lngRow) As Double
- lngID = 1
- For lngRow = UBound(arrTemp) To LBound(arrTemp) Step -1
- '升序排列,以便利用Lookup函数
- arrBoy_Jump(lngID) = arrTemp(lngRow, 2) '立定跳远
- arrBoy_Ball(lngID) = arrTemp(lngRow, 3) '掷实心球
- arrBoy_Rope(lngID) = arrTemp(lngRow, 4) '一分钟跳绳
- arrBoy_SitUp(lngID) = arrTemp(lngRow, 5) '一分钟仰卧起坐
- arrBoy_Result(lngID) = arrTemp(lngRow, 1) '得分
- lngID = lngID + 1
- Next
-
- '女生数据初始化
- arrTemp = SH_Gril.Range("A2:E22")
- lngRow = UBound(arrTemp)
- ReDim arrGril_Jump(0 To lngRow) As Double
- ReDim arrGril_Ball(0 To lngRow) As Double
- ReDim arrGril_Rope(0 To lngRow) As Double
- ReDim arrGril_SitUp(0 To lngRow) As Double
- ReDim arrGril_Result(0 To lngRow) As Double
- lngID = 1
- For lngRow = UBound(arrTemp) To LBound(arrTemp) Step -1
- '升序排列,以便利用Lookup函数
- arrGril_Jump(lngID) = arrTemp(lngRow, 2) '立定跳远
- arrGril_Ball(lngID) = arrTemp(lngRow, 3) '掷实心球
- arrGril_Rope(lngID) = arrTemp(lngRow, 4) '一分钟跳绳
- arrGril_SitUp(lngID) = arrTemp(lngRow, 5) '一分钟仰卧起坐
- arrGril_Result(lngID) = arrTemp(lngRow, 1) '得分
- lngID = lngID + 1
- Next
-
- Set objItem = CreateObject("Scripting.Dictionary")
- Set objResult = CreateObject("Scripting.Dictionary")
-
- objResult("男") = arrBoy_Result
- objResult("女") = arrGril_Result
-
- objItem("Jump-男") = arrBoy_Jump
- objItem("Jump-女") = arrGril_Jump
- objItem("Ball-男") = arrBoy_Ball
- objItem("Ball-女") = arrGril_Ball
- objItem("Rope-男") = arrBoy_Rope
- objItem("Rope-女") = arrGril_Rope
- objItem("SitUp-男") = arrBoy_SitUp
- objItem("SitUp-女") = arrGril_SitUp
- End Function
复制代码 |
评分
-
1
查看全部评分
-
|