|
下記のコードに変更してください。
Private Sub ExGetMax(lcol As Long, 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
Cells(6, lcol) = lmax1
Cells(7, lcol) = lres(lmax1) & "回"
Cells(8, lcol) = lmax2
Cells(9, lcol) = lres(lmax2) & "回"
End Sub
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 ltotaldraw As Long
Dim ltotalhome As Long
Dim lresdraw(13) As Long
Dim lreshome(13) As Long
Dim ldraw As Long
Dim lhome As Long
ltotaldraw = 0
ltotalhome = 0
For i = 0 To 13
lresdraw(i) = 0
lreshome(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)
Call ExCountDraw(tObj, ldraw, lhome)
Cells(10 + i - 1, 3) = ldraw
Cells(10 + i - 1, 4) = lhome
ltotaldraw = ltotaldraw + ldraw
ltotalhome = ltotalhome + lhome
lresdraw(ldraw) = lresdraw(ldraw) + 1
lreshome(lhome) = lreshome(lhome) + 1
'保存せずに閉じる
tObj.Close SaveChanges:=False
Set tObj = Nothing
Next
tExcel.Visible = False
Set tExcel = Nothing
Range("I3") = lcount * 13
Range("K3") = ltotaldraw
Range("K4") = Format(ltotaldraw / lcount, "0.0")
Range("K5") = Format((ltotaldraw / (lcount * 13)) * 100, "0.0")
Range("L3") = ltotalhome
Range("L4") = Format(ltotalhome / lcount, "0.0")
Range("L5") = Format((ltotalhome / (lcount * 13)) * 100, "0.0")
ExGetMax 11, lresdraw
ExGetMax 12, lreshome
End Sub
|
|
|
|
|
|
|
|
|
|
