返回列表 上一主題 發帖

請問如何用ARRAY做資料比對？

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2011-12-16 17:52 | 顯示全部帖子
本帖最後由 GBKEE 於 2011-12-16 17:53 編輯

回復 1# 小俠客
  1. Option Explicit
  2. Public Rng As Range, Rng1 As Range, Rng2 As Range
  3. Sub Restart()
  4.     Sheets(1).Cells.Clear
  5. End Sub
  6. Sub Draw()
  7.     Dim B As Integer, C As Integer, d As Integer
  8.     With Sheet1
  9. L:
  10.         B = Int(100 * Rnd() + 1)
  11.         C = Application.CountIf(.Range("A:A"), B)       '比對是否重復
  12.         If C = 1 Then GoTo L:                           '重做亂數
  13.         d = Application.CountA(.Range("A:A")) + 5
  14.         .Cells(d, 1) = B
  15.         .Cells(d, 1).Select
  16.         Bingo (B)
  17.     End With
  18. End Sub
  19. Sub Paper()
  20.     Dim E As Range, B As Integer, i As Integer, ii As Integer
  21.     Set Rng = [Sheet1!I1:M5]                  '設定數字區域
  22.     For Each E In Rng
  23. L:
  24.         B = Int(100 * Rnd() + 1)
  25.         C = Application.CountIf(Rng, B)        '比對是否重復
  26.         If C = 1 Then GoTo L:
  27.             E = B
  28.     Next
  29.     For i = 1 To 5                             '設定對角線由左至右區域
  30.         If i = 1 Then
  31.             Set Rng1 = Rng.Cells(i, i)
  32.         Else
  33.             Set Rng1 = Union(Rng1, Rng.Cells(i, i))
  34.         End If
  35.     Next
  36.     ii = 5
  37.     For i = 1 To 5                             '設定對角線由右至左區域
  38.         If i = 1 Then
  39.             Set Rng2 = Rng.Cells(i, ii)
  40.         Else
  41.             Set Rng2 = Union(Rng1, Rng.Cells(i, ii))
  42.         End If
  43.         ii = ii - 1
  44.     Next
  45. End Sub
  46. Sub Bingo(No As Integer)
  47.     Dim f As Range, d As Integer, C As Range, i As Integer, ii As Integer
  48.     Set f = Rng.Find(No, LookIn:=xlValues, LOOKAT:=xlWhole)     '尋找數字
  49.     If f Is Nothing Then Exit Sub
  50.     If Not f Is Nothing Then
  51.         f.Font.ColorIndex = 3              '找到數字給字體顏色
  52.         f.Font.FontStyle = "粗體"           '找到數字給字型樣式
  53.     End If
  54.     For i = 1 To Rng.Columns.Count
  55.         d = 0
  56.         For Each C In Rng.Columns(i).Cells
  57.             If C.Font.ColorIndex = 3 Then d = d + 1
  58.         Next
  59.         If d = 5 Then Rng.Columns(i).Select: GoTo ok
  60.      Next
  61.     For i = 1 To Rng.Rows.Count                               '檢查橫列
  62.         d = 0
  63.         For Each C In Rng.Rows(i).Cells
  64.             If C.Font.ColorIndex = 3 Then d = d + 1
  65.         Next
  66.         If d = 5 Then Rng.Rows(i).Select: GoTo ok
  67.     Next
  68.     d = 0
  69.     For Each C In Rng1                                          '檢查對角線
  70.             If C.Font.ColorIndex = 3 Then d = d + 1
  71.     Next
  72.     If d = 5 Then Rng1.Select: GoTo ok
  73.     d = 0
  74.     For Each C In Rng2                                          '檢查對角線
  75.             If C.Font.ColorIndex = 3 Then d = d + 1
  76.     Next
  77.     If d = 5 Then Rng2.Select: GoTo ok
  78. Exit Sub
  79. ok:
  80. MsgBox "Bingo"
  81. End Sub
複製代碼

TOP

        靜思自在 : 有智慧才能分辨善惡邪正；有謙虛才能建立美滿人生。
返回列表 上一主題