超簡單抽獎工具：用 Excel VBA 兩小時交付緊急需求

業務部門臨時需求：現有抽獎軟體單次僅抽一號碼，但本次 500 個中獎名額需逐一點擊記錄，耗時易錯。限期半天，隔天即用。作者果斷選擇 Excel VBA，兩小時完工交付。

一、選擇 VBA 的三大優勢

1. 免資料匯入匯出：資料原本在 Excel，直接操作
2. 專注核心邏輯：無 UI/資料庫/部署干擾，集中精力於隨機抽取演算法
3. 結果易處理：中獎號碼旁可保留其他欄位，整行複製貼上即可後續處理

二、介面截圖

三、核心 VBA 程式碼

' 資料來源工作表欄位
Const START_ROW_SOURCE As Integer = 2
Const ID_SOURCE As String = "B"
Const RESULT_SOURCE As String = "C"
' 結果工作表欄位
Const ID_RESULT As String = "B"
Const FIRST_CELL_RESULT As String = "B5"
Const START_ROW_RESULT As Integer = 5

Private maxRow_Source As Integer

Private Sub cmdDraw_Click()
    On Error GoTo ErrorHandler
    Dim rewardLevel As String: rewardLevel = txtLevel.Text
    Dim rewardCount As Integer
    If Trim(txtCount.Text) <> "" Then rewardCount = CInt(txtCount.Text) Else { MsgBox "請輸入中獎人數！"; Exit Sub }

    maxRow_Source = getMaxRow(shtDataSource)

    ' 清除舊結果
    Dim maxRow_result As Integer: maxRow_result = getMaxRow(shtDrawResult)
    If maxRow_result > START_ROW_RESULT Then
        shtDrawResult.Range(FIRST_CELL_RESULT, shtDrawResult.Cells.SpecialCells(xlCellTypeLastCell)).Value = ""
    End If

    Dim drewCount As Integer = 0, curResultRow As Integer = START_ROW_RESULT
    Dim randomRow As Integer, currentID As String, currentRewardStatus As String

    ' 循環抽取指定數量
    While drewCount < rewardCount
        randomRow = (maxRow_Source - START_ROW_SOURCE + 1) * Rnd + START_ROW_SOURCE
        currentID = shtDataSource.Range(ID_SOURCE & CStr(randomRow)).Cells.Value
        If Trim(currentID) <> "" Then
            currentRewardStatus = shtDataSource.Range(RESULT_SOURCE & CStr(randomRow)).Cells.Value
            If Trim(currentRewardStatus) = "" Then
                ' 複製到結果表
                shtDataSource.Range(ID_SOURCE & CStr(randomRow)).Copy
                shtDrawResult.Range(ID_RESULT & CStr(curResultRow)).PasteSpecial xlPasteAll
                ' 標記已中獎
                shtDataSource.Range(RESULT_SOURCE & CStr(randomRow)).Cells.Value = rewardLevel
                curResultRow = curResultRow + 1
            End If
        End If
        drewCount = drewCount + 1
    Wend
    GoTo ExitHandler
ErrorHandler: MsgBox "出現問題！": Exit Sub
ExitHandler: MsgBox "完成！"
End Sub

Function getMaxRow(sht As Worksheet) As Integer
    Dim lastCell As Range: Set lastCell = sht.Cells.SpecialCells(xlCellTypeLastCell)
    getMaxRow = lastCell.Row
End Function

四、關鍵邏輯說明

• 使用 Rnd 產生隨機行號
• 檢查 RESULT_SOURCE 欄位是否為空，避免重複中獎
• 中獎後將獎項等級寫回來源表，並複製 ID 至結果表
• 支援指定中獎等級與人數，介面輸入即時生效

五、心得與啟示

1. 工具選擇決定成敗：VBA 消除資料遷移、降低業務學習曲線、縮短交付時間
2. 程式無處不在：不只 IDE 能寫軟體，Excel 也是開發平台
3. 務實優於完美：緊急需求下，可用、好用、交付快，即是最佳方案

此經驗分享給所有面對臨時性、資料導向業務需求的開發者。