[已解决]求号码获奖超10元后放到另外sheet?

go1500

要求：
    把《投注号码》中中奖期数大于或等于2期，中奖金额大于10元的单注号码放到sheet2中

最佳答案

月排行榜 / 总排行榜

suye1010

2012-8-10 10:30

1.如果开奖信息区域和投注区域是固定的，请修改以下两句中等号后面的字符为 形如Range("B2:H100")的语句即可

arrDrawn = Application.InputBox("请选择开奖信息区域", "开奖信息", , , , , , 8) '开奖信息区域

arrBet = Application.InputBox("请选择投注号码区域", "投注信息", , , , , , 8) '投注信息区域
2.保留上次信息
Sheets(2).Range("A2:I5000").Clear
Sheets(2).Cells(2, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)
将这两句修改为
Sheets(2).Cells(Sheets(2).Cells(65536,1).End(xlup).Row+1, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)

跳转到最佳答案楼层

兰色幻想

彩票的题目一般都不愿意看，原因大都是没玩过，看不明白。所以提问彩票相关的，要尽量的减少专业的词，要写清具体的单元格位置，也就是说我要根据哪一列哪一行的数据，得到哪个表哪个区域的数据。

go1500

兰色幻想 发表于 2012-8-9 08:23
彩票的题目一般都不愿意看，原因大都是没玩过，看不明白。所以提问彩票相关的，要尽量的减少专业的词，要写 ...

先感谢兰色幻想 的热情提示，谢谢！！

suye1010

1. Option Explicit
   
2. 
   
3. Sub LuckyDraw()
   
4. Dim Winning, d As Object, i As Integer, j As Integer, arrBet, arrDrawn, _
   
5.     BlueBall As Integer, RedBall As Integer, WinningRedBalls As Integer, TempTimes As Integer, TempPrize As Long
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. On Error Resume Next
   
8. arrDrawn = Application.InputBox("请选择开奖信息区域", "开奖信息", , , , , , 8)
   
9. arrBet = Application.InputBox("请选择投注号码区域", "投注信息", , , , , , 8)
   
10. ReDim Winning(1 To 9, 0)
    
11. For i = 1 To UBound(arrBet)
    
12.     d.RemoveAll
    
13.     For RedBall = 1 To 6
    
14.         d(arrBet(i, RedBall)) = arrBet(i, RedBall)
    
15.     Next RedBall
    
16.     For BlueBall = 1 To 16
    
17.         TempTimes = 0
    
18.         TempPrize = 0
    
19.         For j = 1 To UBound(arrDrawn)
    
20.             WinningRedBalls = 0
    
21.             For RedBall = 1 To 6
    
22.                 If d.exists(arrDrawn(j, RedBall)) Then WinningRedBalls = WinningRedBalls + 1
    
23.             Next RedBall
    
24.                 If arrDrawn(j, 7) = BlueBall Then
    
25.                     TempTimes = TempTimes + 1
    
26.                     Select Case WinningRedBalls
    
27.                         Case Is < 3
    
28.                             TempPrize = TempPrize + 5
    
29.                         Case 3
    
30.                             TempPrize = TempPrize + 10
    
31.                         Case 4
    
32.                             TempPrize = TempPrize + 200
    
33.                         Case 5
    
34.                             TempPrize = TempPrize + 3000
    
35.                         Case 6
    
36.                             TempPrize = TempPrize + 5000000
    
37.                     End Select
    
38.                 Else
    
39.                     Select Case WinningRedBalls
    
40.                         Case 4
    
41.                             TempTimes = TempTimes + 1
    
42.                             TempPrize = TempPrize + 10
    
43.                         Case 5
    
44.                             TempTimes = TempTimes + 1
    
45.                             TempPrize = TempPrize + 200
    
46.                         Case 6
    
47.                             TempTimes = TempTimes + 1
    
48.                             TempPrize = TempPrize + 100000
    
49.                     End Select
    
50.                 End If
    
51.         Next j
    
52.         If TempTimes > 1 Or TempPrize > 10 Then
    
53.             If Winning(1, 0) <> "" Then ReDim Preserve Winning(1 To 9, UBound(Winning, 2) + 1)
    
54.             For RedBall = 1 To 6
    
55.                 Winning(RedBall, UBound(Winning, 2)) = arrBet(i, RedBall)
    
56.             Next RedBall
    
57.             Winning(7, UBound(Winning, 2)) = BlueBall
    
58.             Winning(8, UBound(Winning, 2)) = TempTimes
    
59.             Winning(9, UBound(Winning, 2)) = TempPrize
    
60.         End If
    
61.     Next BlueBall
    
62. Next i
    
63. Sheets(2).Range("A2:I5000").Clear
    
64. Sheets(2).Cells(2, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)
    
65. End Sub
    

复制代码

go1500

suye1010 发表于 2012-8-9 21:55

感谢版主的帮助！
还有两问题：1、输出到sheet2时，如sheet2本身有前次计算结果（我想改变些参数，让他们放在一起），新计算的结果想接着上次的结果排下去（不想把上次结果清除掉），这两句怎么改呢？
Sheets(2).Range("A2:I5000").Clear
Sheets(2).Cells(2, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)
2、我想固化“开奖信息区域”与“投注号码区域”，不用每次输入，如何改？

suye1010

1.如果开奖信息区域和投注区域是固定的，请修改以下两句中等号后面的字符为 形如Range("B2:H100")的语句即可

arrDrawn = Application.InputBox("请选择开奖信息区域", "开奖信息", , , , , , 8) '开奖信息区域

arrBet = Application.InputBox("请选择投注号码区域", "投注信息", , , , , , 8) '投注信息区域
2.保留上次信息
Sheets(2).Range("A2:I5000").Clear
Sheets(2).Cells(2, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)
将这两句修改为
Sheets(2).Cells(Sheets(2).Cells(65536,1).End(xlup).Row+1, 1).Resize(UBound(Winning, 2), 9) = Application.Transpose(Winning)

go1500

suye1010 发表于 2012-8-10 10:30
1.如果开奖信息区域和投注区域是固定的，请修改以下两句中等号后面的字符为 形如Range("B2:H100")的语句即可 ...

非常感谢！！楼主谢谢你！

go1500

suye1010 发表于 2012-8-10 10:30
1.如果开奖信息区域和投注区域是固定的，请修改以下两句中等号后面的字符为 形如Range("B2:H100")的语句即可 ...

    楼主的使用字典实在太强大了，恳请版主再帮一把