这堆东西有搞头没？
本帖最后由 Ganve_001 于 2011-8-17 17:47 编辑据说万物皆有规律。。我每天根据这个去买一注。。会不会瞎猫碰到死老鼠？？？:funk:
当然写的比较乱。。优化和改造地方很多
Dim BlueNumber,RedNumber
Dim objExcel,objWorkBook,objWorkSheet,ColNo,Col,addRow
Dim Times,Com,i,j
Dim DabouleBall(7)
Dim FilePath
For Times=1 to 7
If Times< 7 Then
BlueNumber= Randomnumber(1,33)
For Com =1 to 6
If DabouleBall(Com) = BlueNumber Then
Times = Times -1
Exit For
Else
'Keep Doing
End If
If Com = 6 Then
DabouleBall(Times) = BlueNumber
End If
Next
ElseIf Times = 7 Then
RedNumber = Randomnumber(1,16)
DabouleBall(Times) = RedNumber
End If
Next
For i = 1 to 5
For j = i +1 to 6
If DabouleBall(i) >DabouleBall(j) Then
Trans= DabouleBall(i)
DabouleBall(i) = DabouleBall(j)
DabouleBall(j)= Trans
End If
Next
Next
FilePath = "E:\DoubleBall.xlsx"
Set Fso= CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(FilePath) = False Then
Set objExcel= CreateObject("Excel.Application")
Set objWorkBook = objExcel.Workbooks.Add
Set objWorkSheet = objWorkBook.ActiveSheet
For ColNo = 0 to 7
Col = chr(65+ColNo)
If ColNo= 0 Then
objWorkSheet.Range(Col & 1) ="Date"
ElseIfColNo=7 Then
objWorkSheet.Range(Col & 1) ="RedNo."
Else
objWorkSheet.Range(Col & 1) ="BlueNo."
End If
Next
objWorkBook.SaveAs(FilePath)
objExcel.Workbooks.Close
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Else
Set objExcel= CreateObject("Excel.Application")
'objExcel.Visible = True
Set objWorkBook = objExcel.Workbooks.Open(FilePath)
Set objWorkSheet = objWorkBook.ActiveSheet
Set objWorkRange =objWorkBook.ActiveSheet.UsedRange
addRow = objWorkRange.Rows.count+1
For ColNo = 0to 7
Col = chr(65+ColNo)
If ColNo= 0 Then
objWorkSheet.Range(Col & addRow) =Date
'objWorkSheet.Range(Col & addRow).Interior.colorindex=4
Else
objWorkSheet.Range(Col & addRow)= DabouleBall(ColNo)
End If
Next
objWorkBook.Save
objExcel.Workbooks.Close
objExcel.Quit
Set objWorkRange = Nothing
Set objWorkSheet =Nothing
SetobjWorkBook =Nothing
Set objExcel =Nothing
End If
完全没搞头……坐等5亿归来
页:
[1]
