Board logo

標題: 設計一個對獎程式 [打印本頁]
作者: flutist    時間: 2012-12-11 15:33     標題: 設計一個對獎程式

請問如何設計一個對獎程式?我有附件

[attach]13492[/attach]
作者: stillfish00    時間: 2012-12-11 17:13

回復 1# flutist
蠻偷懶的寫法...
  1. Sub LottoRun()
  2.     With Sheets("Sheet1").[D2]
  3.     Select Case [=IFERROR(SUM(COUNTIF(Sheet1!B2:B6,OFFSET(Sheet2!B1:G1,MATCH(Sheet1!A2,Sheet2!A:A,0)-1,)))*10+(B7=OFFSET(Sheet2!H1,MATCH(Sheet1!A2,Sheet2!A:A,0)-1,)),-1)]
  4.         Case 61
  5.             .Value = "恭喜你對中頭獎"
  6.         Case 51
  7.             .Value = "恭喜你對中貳獎"
  8.         Case 50
  9.             .Value = "恭喜你對中參獎"
  10.         Case 41
  11.             .Value = "恭喜你對中肆獎"
  12.         Case 40
  13.             .Value = "恭喜你對中伍獎"
  14.         Case 31
  15.             .Value = "恭喜你對中陸獎，獎金$1,000"
  16.         Case 30
  17.             .Value = "恭喜你對中普獎，獎金$400"
  18.         Case -1
  19.             .Value = "期別找不到"
  20.         Case Else
  21.             .Value = "殘念"
  22.     End Select
  23.     .EntireColumn.AutoFit
  24.     End With
  25. End Sub
複製代碼
作者: stillfish00    時間: 2012-12-11 17:23

更正 頭獎為Case 60
作者: stillfish00    時間: 2012-12-11 17:29

應該是Case 60, 61  
作者: Hsieh    時間: 2012-12-11 18:26

本帖最後由 Hsieh 於 2012-12-11 18:30 編輯

回復 1# flutist
基本上使用公式即可達成，寫成VBA最好配合事件程序
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Intersect(Target, [B3:B7]) Is Nothing Then Exit Sub
  3. If Application.CountIf(Sheet2.[A:A], Sheet1.[A2]) = 0 Then Sheet1.[D2] = "期別錯誤": Exit Sub '期別錯誤
  4. '基本號碼
  5. x = _
  6. Evaluate("=SUMPRODUCT(ISNUMBER(1/COUNTIF(OFFSET(Sheet2!$A$1,MATCH(Sheet1!$A$2,Sheet2!$A:$A,0)-1,1,,6),Sheet1!$B$2:$B$7))*1)")
  7. '特別號
  8. y = _
  9. Evaluate("=ISNUMBER(MATCH(OFFSET(Sheet2!$A$1,MATCH(Sheet1!$A$2,Sheet2!$A:$A,0)-1,7),Sheet1!$B$2:$B$7,0))*0.5")
  10. Sheet1.[D2] = Application.Lookup(x + y, Array(0, 3, 3, 5, 4, 4.5, 5, 5.5, 6), Array("未中獎", "普獎", "陸獎", "伍獎", "肆獎", "三獎", "貳獎", "頭獎"))
  11. End Sub
複製代碼
作者: flutist    時間: 2012-12-12 08:27

公式我會設計
但VBA就不行了
謝謝前輩指導
作者: GBKEE    時間: 2012-12-12 08:37

回復 6# flutist
  1. Option Explicit
  2. Sub Ex()
  3.     Dim 期別 As Range, Msg As String, xi As Integer, xS As Integer
  4.     With Sheets("Sheet1")
  5.         .[B2:B7].Name = "投注區"
  6.         Set 期別 = Sheets("sheet2").Range("a:a").Find(.[a2], lookat:=xlWhole)       '尋找期別
  7.         Msg = IIf(期別 Is Nothing, "期    別:" & .[a2] & " 找不到!!! " & vbLf, "") & _
  8.               IIf([COUNT(投注區)] <> 6, "投注區: 號碼不齊全", "")                   '[COUNT(投注區)] <> 6 投注號碼需有6個
  9.         If Msg <> "" Then MsgBox Msg: Exit Sub
  10.         [投注區].Interior.ColorIndex = .[a2].Interior.ColorIndex                    '制定投注區底色
  11.         For xi = 1 To 7
  12.             If IsNumeric(Application.Match(期別.Offset(, xi), [投注區], 0)) Then    '開出獎號一一比對   投注號碼
  13.                 If xi < 6 Then
  14.                  xS = xS + 1
  15.                  [投注區].Cells(Application.Match(期別.Offset(, xi), [投注區], 0)).Interior.ColorIndex = 17  '開出號號:制定底色
  16.                 Else
  17.                   Msg = "OK"        '特別號
  18.                   [投注區].Cells(Application.Match(期別.Offset(, xi), [投注區], 0)).Interior.ColorIndex = 7   '特別號:制定底色
  19.                 End If
  20.             End If
  21.         Next
  22.         With .[D2]
  23.             Select Case xS
  24.                 Case 6
  25.                     .Value = "「恭喜你對中頭獎」"
  26.                 Case 5
  27.                     .Value = IIf(Msg <> "", "「恭喜你對中貳獎」", "「恭喜你對中參獎」")
  28.                 Case 4
  29.                     .Value = IIf(Msg <> "", "「恭喜你對中肆獎」", "「恭喜你對中伍獎」")
  30.                 Case 3
  31.                     .Value = IIf(Msg <> "", "「恭喜你對中陸獎」", "「獎金$1,000」")
  32.                 Case 2
  33.                     .Value = IIf(Msg <> "", "「恭喜你對中普獎」", "「獎金$400」")
  34.                 Case Else
  35.                 .Value = "下期再來"
  36.             End Select
  37.         End With
  38.     End With
複製代碼
作者: freeffly    時間: 2012-12-12 16:34

以前100組100萬時有看過人家用函數搭配簡單的vba
不過主要是以函數為主
第一次看到用vba對獎的



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)