|
本帖最后由 Ganve_001 于 2011-8-17 17:47 编辑
据说万物皆有规律。。我每天根据这个去买一注。。会不会瞎猫碰到死老鼠???
当然写的比较乱。。优化和改造地方很多
-
- 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"
- ElseIf ColNo=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 = 0 to 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
- Set objWorkBook =Nothing
- Set objExcel =Nothing
- End If
复制代码 |
|