Public intCC As Integer '同行和学生评分平局分数据记录数
FrmMain代码： Dim intC As Integer
Dim ArrSuoZaiDanWei() As Double Dim ArrKeChengKaiChu() As Double Dim F1 As Integer
Dim F3 As Integer Dim F4 As Integer
Private Sub Command1_Click() cd.Filter = \电子表格)|*.xls\
cd.ShowOpen intC = 0 intCC = 0 On Error GoTo errH
If cd.FileName <> \ Dim ExcelApp As Object Dim ExcelWorkBook As Object Dim ExcelWorkSheet As Object
Set ExcelApp = CreateObject(\
Set ExcelWorkBook = ExcelApp.Workbooks.Open(cd.FileName) Set ExcelWorkSheet = ExcelWorkBook.Worksheets(2) Dim NN As Long For NN = 4 To 65535
17
If Trim(ExcelWorkSheet.Cells(NN, 4)) = \And
Trim(ExcelWorkSheet.Cells(NN + 1, 4)) = \\ Exit For End If Next intC = NN - 4
ReDim ArrXueSheng(intC) ReDim ArrData(intC) For NN = 4 To 4 + intC - 1
ArrData(NN - 3).JYZ = Trim(ExcelWorkSheet.Cells(NN, 5)) ArrData(NN - 3).GH = Trim(ExcelWorkSheet.Cells(NN, 6)) ArrData(NN - 3).XM = Trim(ExcelWorkSheet.Cells(NN, 7)) ArrData(NN - 3).XSPF CDbl(IIf(IsNumeric(ExcelWorkSheet.Cells(NN, 8)), ExcelWorkSheet.Cells(NN, 8), \ ArrData(NN
-
3).THPF
CDbl(IIf(IsNumeric(ExcelWorkSheet.Cells(NN, 9)), ExcelWorkSheet.Cells(NN, 9), \
ArrData(NN - 3).CS = 1 ArrData(NN - 3).FLAG = True Next
ExcelWorkBook.Close ExcelApp.Quit Set ExcelApp = Nothing Set ExcelWorkBook = Nothing Set ExcelWorkSheet = Nothing F1 = 1 End If
18
= =
For i = 1 To intC
If ArrData(i).FLAG = True Then For j = i + 1 To intC
If ArrData(i).GH = ArrData(j).GH Then
ArrData(i).XSPF = ArrData(i).XSPF + ArrData(j).XSPF ArrData(i).THPF = ArrData(i).THPF + ArrData(j).THPF ArrData(j).FLAG = False ArrData(i).CS = ArrData(i).CS + 1 End If Next
intCC = intCC + 1 End If Next
ReDim ArrDataLast(intCC) j = 1
For i = 1 To intC
If ArrData(i).FLAG = True Then ArrDataLast(j).JYZ = ArrData(i).JYZ ArrDataLast(j).GH = ArrData(i).GH ArrDataLast(j).XM = ArrData(i).XM
ArrDataLast(j).XSPF = FormatNumber(ArrData(i).XSPF / ArrData(i).CS, 2)
ArrDataLast(j).THPF = FormatNumber(ArrData(i).THPF / ArrData(i).CS, 2)
19
j = j + 1 End If Next
MsgBox \读取完毕\ Exit Sub errH:
ExcelWorkBook.Close ExcelApp.Quit Set ExcelApp = Nothing Set ExcelWorkBook = Nothing Set ExcelWorkSheet = Nothing MsgBox Err.Description End Sub
Private Sub Command2_Click() cd.Filter = \电子表格)|*.xls\
cd.ShowOpen intC = 0
Dim ArrTmp() As String On Error GoTo errH
If cd.FileName <> \ Dim ExcelApp As Object Dim ExcelWorkBook As Object Dim ExcelWorkSheet As Object
Set ExcelApp = CreateObject(\
20
Set ExcelWorkBook = ExcelApp.Workbooks.Open(cd.FileName) Set ExcelWorkSheet = ExcelWorkBook.Worksheets(1) Dim NN As Long For NN = 4 To 65535 If
Trim(ExcelWorkSheet.Cells(NN,
4))
=
\
And
Trim(ExcelWorkSheet.Cells(NN + 1, 4)) = \\ Exit For End If Next intC = NN - 4
ReDim ArrSuoZaiDanWei(intC) ReDim ArrTmp(intC) For NN = 4 To 4 + intC - 1
ArrTmp(NN - 3) = Trim(ExcelWorkSheet.Cells(NN, 2)) ArrSuoZaiDanWei(NN Next
ExcelWorkBook.Close ExcelApp.Quit Set ExcelApp = Nothing Set ExcelWorkBook = Nothing Set ExcelWorkSheet = Nothing F3 = 1
For i = 1 To intCC For j = 1 To intC
If ArrDataLast(i).XM = ArrTmp(j) Then
ArrDataLast(i).DWPF = ArrSuoZaiDanWei(j)
-
3)
=
CDbl(IIf(IsNumeric(ExcelWorkSheet.Cells(NN, 13)), ExcelWorkSheet.Cells(NN, 13), \
21