|
Private Sub ExGetMax(lres() As Long)
Dim lmax1 As Long
Dim lmax2 As Long
Dim lm As Long
Dim i As Long
Dim ln(13) As Long
ln(0) = lres(0)
lm = lres(0)
For i = 1 To 13
ln(i) = lres(i)
If lres(i) > lm Then
lm = lres(i)
lmax1 = i
End If
Next
ln(lmax1) = 0
lm = ln(0)
For i = 1 To 13
If ln(i) > lm Then
lm = ln(i)
lmax2 = i
End If
Next
Range("E6") = lmax1
Range("F6") = lres(lmax1) & "回"
Range("E7") = lmax2
Range("F7") = lres(lmax2) & "回"
End Sub
Private Function ExCountDraw(tObj As Object) As Long
Dim i As Integer
Dim ln As Long
Dim ld As Long
ld = 0
For i = 1 To 13
ln = tObj.Worksheets(1).Cells(i + 4, 7).Value
If ln = 0 Then
ld = ld + 1
End If
Next
ExCountDraw = ld
End Function
'結果のファイルを開く
Private Sub ExGetTotoData(sdir As String, lcount As Long)
Dim i As Integer
Dim sfina As String
Dim tExcel As Object
Dim tObj As Object
Dim ltotal As Long
Dim ln As Long
Dim lres(13) As Long
ltotal = 0
For i = 0 To 13
lres(i) = 0
Next
If Right(sdir, 1) <> "\" Then sdir = sdir & "\"
Set tExcel = CreateObject("Excel.Application")
tExcel.Visible = True
For i = 1 To lcount
sfina = Cells(10 + i - 1, 2)
Set tObj = tExcel.Application.Workbooks.Open(Filename:=sdir & sfina)
ln = ExCountDraw(tObj)
Cells(10 + i - 1, 3) = ln
ltotal = ltotal + ln
lres(ln) = lres(ln) + 1
'保存せずに閉じる
tObj.Close SaveChanges:=False
Set tObj = Nothing
Next
tExcel.Visible = False
Set tExcel = Nothing
Range("E3") = ltotal
Range("E4") = Format(ltotal / lcount, "0.0")
Range("E5") = Format((ltotal / (lcount * 13)) * 100, "0.0")
ExGetMax lres
End Sub |
|
|
|
|
|
|
|
|
|
