close
標題:
如何用 vb 生成 1800 張 不同的 bingo card ?
bingo card 規格: 7x7 (no free space) number 為 1 - 100 每張card 必需有49 個不同的number 然後生成1800 張不同的 card 最後可生成 .txt 檔 以方便列印 有難道吧? 更新: thx x n階乘 ~!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
最佳解答:
please try following code. just do it with excel vba, ok? only generate 64 times. just amend the sub CallAll to generate 1800 times and the path. Public aBingo(49) As Integer Sub FileOut(sFile As String) Dim i, j As Integer Dim sLine As String Open sFile For Output As #1 For i = 0 To 6 sLine = "" For j = 0 To 6 sLine = sLine & Trim(Val(aBingo(i * 7 + j))) & "," Next Print #1, Left(sLine, Len(sLine) - 1) ' MsgBox Left(sLine, Len(sLine) - 1) Next Close #1 End Sub Sub BingoGen() Dim i, j As Integer Dim a(48) As Integer i = 0 Do j = Int((49 * Rnd) + 1) If a(j - 1) <> 1 Then aBingo(i) = j a(j - 1) = 1 i = i + 1 End If If i >= 49 Then Exit Do End If Loop End Sub Sub CallAll() Dim i As Integer Dim sFileName As String For i = 1 To 64 sFileName = Trim(Str(Val(i))) sFileName = "C:\TEMP\B_" & String(4 - Len(sFileName), "0") & sFileName & ".TXT" Call BingoGen Call FileOut(sFileName) Next End Sub hope can help u
其他解答:
Excel VBA 1.) 首先將 Sheet1 B2:H8 (即 7 x 7)劃妥格線/外框 再調節欄寬及列高; 水平及垂直調至置中位置; 預覽列印調節周界 達到最佳的列印效果。 2.) 程式: Sub bingox() Dim bingo(100) cards = 1800 Set aaa = Range("B2:H8") For c = 1 To cards aaa.ClearContents For t = 1 To 100 bingo(t) = 0 Next t For x = 1 To 49 rernd: a = Int(Rnd() * 100 + 1) If bingo(a) > 0 Then GoTo rernd bingo(a) = a aaa(x) = a Next x ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next c End Sub 3.) 如 500張咭, 1 - 150, 5 x 5 = 25 程式便要將 1800 改成 500 100 改成 150 49 改成 25 Range("B2:H8") 改成 Range("B2:F6") 4.) 由於程式(即巨集)執行時, 即馬上進行列印, 建議先將 Cards 改成5以下,測試效果。 5.) 如需(在Sheet2做資料庫)儲存每張咭的資料及加上編號, 程式亦不太複雜, 如需要請再提問。先做妥資料庫, 再進行列印會更安全，當然上述程式要有很多修改。
如何用 vb 生成 1800 張 不同的 bingo card ?
此文章來自奇摩知識+如有不便請留言告知
發問:bingo card 規格: 7x7 (no free space) number 為 1 - 100 每張card 必需有49 個不同的number 然後生成1800 張不同的 card 最後可生成 .txt 檔 以方便列印 有難道吧? 更新: thx x n階乘 ~!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
最佳解答:
please try following code. just do it with excel vba, ok? only generate 64 times. just amend the sub CallAll to generate 1800 times and the path. Public aBingo(49) As Integer Sub FileOut(sFile As String) Dim i, j As Integer Dim sLine As String Open sFile For Output As #1 For i = 0 To 6 sLine = "" For j = 0 To 6 sLine = sLine & Trim(Val(aBingo(i * 7 + j))) & "," Next Print #1, Left(sLine, Len(sLine) - 1) ' MsgBox Left(sLine, Len(sLine) - 1) Next Close #1 End Sub Sub BingoGen() Dim i, j As Integer Dim a(48) As Integer i = 0 Do j = Int((49 * Rnd) + 1) If a(j - 1) <> 1 Then aBingo(i) = j a(j - 1) = 1 i = i + 1 End If If i >= 49 Then Exit Do End If Loop End Sub Sub CallAll() Dim i As Integer Dim sFileName As String For i = 1 To 64 sFileName = Trim(Str(Val(i))) sFileName = "C:\TEMP\B_" & String(4 - Len(sFileName), "0") & sFileName & ".TXT" Call BingoGen Call FileOut(sFileName) Next End Sub hope can help u
其他解答:
Excel VBA 1.) 首先將 Sheet1 B2:H8 (即 7 x 7)劃妥格線/外框 再調節欄寬及列高; 水平及垂直調至置中位置; 預覽列印調節周界 達到最佳的列印效果。 2.) 程式: Sub bingox() Dim bingo(100) cards = 1800 Set aaa = Range("B2:H8") For c = 1 To cards aaa.ClearContents For t = 1 To 100 bingo(t) = 0 Next t For x = 1 To 49 rernd: a = Int(Rnd() * 100 + 1) If bingo(a) > 0 Then GoTo rernd bingo(a) = a aaa(x) = a Next x ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next c End Sub 3.) 如 500張咭, 1 - 150, 5 x 5 = 25 程式便要將 1800 改成 500 100 改成 150 49 改成 25 Range("B2:H8") 改成 Range("B2:F6") 4.) 由於程式(即巨集)執行時, 即馬上進行列印, 建議先將 Cards 改成5以下,測試效果。 5.) 如需(在Sheet2做資料庫)儲存每張咭的資料及加上編號, 程式亦不太複雜, 如需要請再提問。先做妥資料庫, 再進行列印會更安全，當然上述程式要有很多修改。
文章標籤
全站熱搜
留言列表
