Excel VBA | 巨大業務アプリ（一覧 → 詳細 → 編集 → ログイン → 検索）を統合した完全サンプル

Excel VBA VBA
スポンサーリンク

概要と目的

このサンプルは 「一覧 → 詳細 → 行編集（Add/Edit/Delete）→ ログイン → 検索」 を統合した 業務向け Excel VBA アプリケーションの完全サンプル です。
設計方針は以下の通りです（再利用性・保守性重視）：

  • UI（UserForm）は薄く、ロジック（操作・データ制御）はクラス/標準モジュールに集約
  • シンプルなワークフローで、導入・改修が容易
  • そのままコピペして動く（必要なフォーム／クラス名とコントロール名は本文に明記）

以下を順に載せます：プロジェクト構成、データ配置、標準モジュール、クラスモジュール、UserForm（UI）コード、起動方法、補足（拡張ポイント）。

プロジェクト構成（ファイル／オブジェクト一覧）

Modules:
  - UI_Common (標準モジュール)
  - AppEntry  (標準モジュール: 起動/終了/グローバル)

Class Modules:
  - CLogin
  - CRowEditor
  - CListDetail
  - CSearchDialog
  - CProgressBar

UserForms:
  - frmLogin     (txtUser, txtPass, btnOK, btnCancel)
  - frmMain      (lstData, btnDetail, btnAdd, btnEdit, btnDel, btnSearch, btnRefresh, lblStatus)
  - frmDetail    (txtID, txtName, txtQty, btnSave, btnCancel)
  - frmSearch    (txtKey, btnSearch, lstResult, btnSelect)
  - frmProgress  (lblBar, lblMsg)  'モデルレスで進捗表示
VB

データ配置（サンプルシート）

  • シート名：Data（変更可）
  • データは A列〜C列
    • A: ID（ユニーク）
    • B: 名称（Name）
    • C: 数量（Qty）
  • 1行目にヘッダ（ID, Name, Qty）を置く想定

例：

A1: ID   B1: Name    C1: Qty
A2: 001  B2: 商品A   C2: 10
A3: 002  B3: 商品B   C3: 5
...

UI_Common（標準モジュール）

汎用ユーティリティ。標準モジュールとして追加してください。

' ===== UI_Common =====
Option Explicit

Public Sub UI_FormCenter(frm As Object)
    On Error Resume Next
    frm.StartUpPosition = 1 '0=manual,1=centerowner
    frm.Left = (Application.UsableWidth - frm.Width) / 2
    frm.Top = (Application.UsableHeight - frm.Height) / 2
End Sub

Public Sub UI_SetListFromRange(lst As MSForms.ListBox, src As Range)
    If src Is Nothing Then Exit Sub
    lst.Clear
    Dim arr As Variant
    arr = src.Value
    Dim r As Long
    For r = 2 To UBound(arr, 1) ' header を除く2行目から
        lst.AddItem arr(r, 1)
        lst.List(lst.ListCount - 1, 1) = arr(r, 2)
        lst.List(lst.ListCount - 1, 2) = arr(r, 3)
    Next r
End Sub

Public Sub UI_ClearList(lst As MSForms.ListBox)
    lst.Clear
End Sub

Public Function UI_FindRowByID(ws As Worksheet, id As Variant) As Range
    Dim f As Range
    Set f = ws.Columns(1).Find(What:=id, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then
        Set UI_FindRowByID = f.EntireRow
    Else
        Set UI_FindRowByID = Nothing
    End If
End Function
VB

CLogin（クラスモジュール）

ユーザ認証の責務を持たせます。Class Module 名は CLogin にしてください。

' ===== CLogin =====
Option Explicit

Private pUser As String
Private pPass As String

Public Sub Init(userName As String, passWord As String)
    pUser = userName
    pPass = passWord
End Sub

Public Function Authenticate(inputUser As String, inputPass As String) As Boolean
    ' 簡易版：ハードコード or 将来外部DBチェックに差し替え可能
    Authenticate = (inputUser = pUser And inputPass = pPass)
End Function
VB

CRowEditor（クラスモジュール）

行の追加・編集・削除ロジックを担当。Class Module 名は CRowEditor。

' ===== CRowEditor =====
Option Explicit

Private ws As Worksheet

Public Sub Init(targetSheet As Worksheet)
    Set ws = targetSheet
End Sub

Public Function AddRow(id As String, name As String, qty As Variant) As Boolean
    If id = "" Then AddRow = False: Exit Function
    If Not UI_FindRowByID(ws, id) Is Nothing Then AddRow = False: Exit Function
    Dim r As Long
    r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    ws.Cells(r, "A").Value = id
    ws.Cells(r, "B").Value = name
    ws.Cells(r, "C").Value = qty
    AddRow = True
End Function

Public Function EditRow(id As String, name As String, qty As Variant) As Boolean
    Dim rowRng As Range
    Set rowRng = UI_FindRowByID(ws, id)
    If rowRng Is Nothing Then EditRow = False: Exit Function
    rowRng.Cells(1, 2).Value = name
    rowRng.Cells(1, 3).Value = qty
    EditRow = True
End Function

Public Function DeleteRow(id As String) As Boolean
    Dim rowRng As Range
    Set rowRng = UI_FindRowByID(ws, id)
    If rowRng Is Nothing Then DeleteRow = False: Exit Function
    rowRng.EntireRow.Delete
    DeleteRow = True
End Function
VB

CListDetail（クラスモジュール）

一覧表示→詳細表示（ListBox にクリックで詳細を開く）を管理。Class Module 名 CListDetail。

' ===== CListDetail =====
Option Explicit

Private src As Range
Private ws As Worksheet

Public Sub Init(targetSheet As Worksheet, Optional dataRange As Range)
    Set ws = targetSheet
    If Not dataRange Is Nothing Then
        Set src = dataRange
    Else
        Set src = ws.Range("A1").CurrentRegion
    End If
End Sub

Public Sub PopulateList(lst As MSForms.ListBox)
    If src Is Nothing Then Set src = ws.Range("A1").CurrentRegion
    UI_SetListFromRange lst, src
End Sub

Public Function GetRowByListIndex(lst As MSForms.ListBox, idx As Long) As Range
    If idx < 0 Or idx > lst.ListCount - 1 Then
        Set GetRowByListIndex = Nothing
        Exit Function
    End If
    Dim id As Variant
    id = lst.List(idx, 0)
    Set GetRowByListIndex = UI_FindRowByID(ws, id)
End Function
VB

CSearchDialog（クラスモジュール）

検索ダイアログのロジック。Class Module 名 CSearchDialog。

' ===== CSearchDialog =====
Option Explicit

Private ws As Worksheet
Private src As Range

Public Sub Init(targetSheet As Worksheet, Optional dataRange As Range)
    Set ws = targetSheet
    If Not dataRange Is Nothing Then Set src = dataRange Else Set src = ws.Range("A1").CurrentRegion
End Sub

Public Sub SearchKeyShow(frm As Object, key As String)
    ' frm: frmSearch インスタンス
    frm.lstResult.Clear
    Dim r As Range
    For Each r In src.Resize(src.Rows.Count - 1).Offset(1, 0).Rows
        If key = "" Or InStr(1, CStr(r.Cells(1, 2).Value), key, vbTextCompare) > 0 _
           Or InStr(1, CStr(r.Cells(1, 1).Value), key, vbTextCompare) > 0 Then
            frm.lstResult.AddItem r.Cells(1, 1).Value
            frm.lstResult.List(frm.lstResult.ListCount - 1, 1) = r.Cells(1, 2).Value
            frm.lstResult.List(frm.lstResult.ListCount - 1, 2) = r.Cells(1, 3).Value
        End If
    Next r
End Sub
VB

CProgressBar（クラスモジュール）

長時間処理向け。Class Module 名 CProgressBar。

' ===== CProgressBar =====
Option Explicit

Private frm As frmProgress

Public Sub Start(msg As String)
    Set frm = New frmProgress
    frm.lblMsg.Caption = msg
    frm.lblBar.Width = 0
    frm.Show vbModeless
    DoEvents
End Sub

Public Sub SetPercent(p As Double)
    If p < 0 Then p = 0
    If p > 1 Then p = 1
    On Error Resume Next
    frm.lblBar.Width = frm.Width * p
    DoEvents
End Sub

Public Sub Finish()
    On Error Resume Next
    Unload frm
End Sub
VB

UserForm：frmLogin（コード）

フォームのコントロール名：txtUser(TextBox), txtPass(TextBox, PasswordChar=”*”), btnOK, btnCancel

' frmLogin code
Option Explicit

Private Sub btnOK_Click()
    Me.Hide
End Sub

Private Sub btnCancel_Click()
    Me.txtUser = ""
    Me.txtPass = ""
    Me.Hide
End Sub
VB

（認証判定は AppEntry 側で行います）

UserForm：frmMain（コード）

コントロール：lstData(ListBox, ColumnCount=3)、btnDetail, btnAdd, btnEdit, btnDel, btnSearch, btnRefresh, lblStatus(Label)

' frmMain code
Option Explicit
Private app As CListDetail
Private editor As CRowEditor

Private Sub UserForm_Initialize()
    Set app = New CListDetail
    Set editor = New CRowEditor
    app.Init ThisWorkbook.Worksheets("Data")
    editor.Init ThisWorkbook.Worksheets("Data")
    Call app.PopulateList(Me.lstData)
End Sub

Private Sub btnRefresh_Click()
    Call app.PopulateList(Me.lstData)
    lblStatus.Caption = "一覧を更新しました: " & Format(Now, "yyyy/mm/dd hh:nn:ss")
End Sub

Private Sub btnDetail_Click()
    If Me.lstData.ListIndex = -1 Then MsgBox "行を選択してください": Exit Sub
    Dim rowRng As Range
    Set rowRng = app.GetRowByListIndex(Me.lstData, Me.lstData.ListIndex)
    If rowRng Is Nothing Then MsgBox "該当データが見つかりません": Exit Sub
    frmDetail.txtID = rowRng.Cells(1, 1).Value
    frmDetail.txtName = rowRng.Cells(1, 2).Value
    frmDetail.txtQty = rowRng.Cells(1, 3).Value
    frmDetail.Show vbModal
    Call btnRefresh_Click
End Sub

Private Sub btnAdd_Click()
    frmDetail.txtID = ""
    frmDetail.txtName = ""
    frmDetail.txtQty = ""
    frmDetail.Show vbModal
    Call btnRefresh_Click
End Sub

Private Sub btnEdit_Click()
    If Me.lstData.ListIndex = -1 Then MsgBox "行を選択してください": Exit Sub
    Dim rowRng As Range
    Set rowRng = app.GetRowByListIndex(Me.lstData, Me.lstData.ListIndex)
    If rowRng Is Nothing Then MsgBox "該当データが見つかりません": Exit Sub
    frmDetail.txtID = rowRng.Cells(1, 1).Value
    frmDetail.txtName = rowRng.Cells(1, 2).Value
    frmDetail.txtQty = rowRng.Cells(1, 3).Value
    frmDetail.Show vbModal
    Call btnRefresh_Click
End Sub

Private Sub btnDel_Click()
    If Me.lstData.ListIndex = -1 Then MsgBox "行を選択してください": Exit Sub
    Dim id As String
    id = Me.lstData.List(Me.lstData.ListIndex, 0)
    If MsgBox("ID=" & id & " を削除しますか？", vbYesNo + vbQuestion) = vbYes Then
        Dim ok As Boolean
        ok = editor.DeleteRow(id)
        If ok Then MsgBox "削除しました": Call btnRefresh_Click Else MsgBox "削除失敗"
    End If
End Sub

Private Sub btnSearch_Click()
    frmSearch.Show
    Call btnRefresh_Click
End Sub
VB

UserForm：frmDetail（コード）

コントロール：txtID, txtName, txtQty, btnSave, btnCancel
このフォームは Add / Edit を兼用します。保存処理は CRowEditor を利用。

' frmDetail code
Option Explicit
Private editor As CRowEditor

Private Sub UserForm_Initialize()
    Set editor = New CRowEditor
    editor.Init ThisWorkbook.Worksheets("Data")
End Sub

Private Sub btnSave_Click()
    Dim id As String, nm As String, q As Variant
    id = Trim(Me.txtID)
    nm = Trim(Me.txtName)
    q = Trim(Me.txtQty)
    If id = "" Then MsgBox "IDを入力してください": Exit Sub
    If nm = "" Then MsgBox "名称を入力してください": Exit Sub

    Dim existing As Range
    Set existing = UI_FindRowByID(ThisWorkbook.Worksheets("Data"), id)
    Dim ok As Boolean
    If existing Is Nothing Then
        ok = editor.AddRow(id, nm, q)
        If ok Then
            MsgBox "追加しました"
            Me.Hide
        Else
            MsgBox "追加に失敗しました（重複ID等）"
        End If
    Else
        ok = editor.EditRow(id, nm, q)
        If ok Then
            MsgBox "更新しました"
            Me.Hide
        Else
            MsgBox "更新に失敗しました"
        End If
    End If
End Sub

Private Sub btnCancel_Click()
    Me.Hide
End Sub
VB

UserForm：frmSearch（コード）

コントロール：txtKey, btnSearch, lstResult(ListBox), btnSelect
btnSelect は選択行を frmMain に反映する補助（ここでは選択したIDをクリップボード経由で渡すか、frmMainのリフレッシュで反映させる選択肢が取れます。簡潔さのため、btnSelectで選んだIDを選択してfrmMain再表示を促す設計にします。）

' frmSearch code
Option Explicit
Private searcher As CSearchDialog

Private Sub UserForm_Initialize()
    Set searcher = New CSearchDialog
    searcher.Init ThisWorkbook.Worksheets("Data")
End Sub

Private Sub btnSearch_Click()
    searcher.SearchKeyShow Me, Trim(Me.txtKey)
End Sub

Private Sub btnSelect_Click()
    If Me.lstResult.ListIndex = -1 Then MsgBox "選択してください": Exit Sub
    Dim id As String
    id = Me.lstResult.List(Me.lstResult.ListIndex, 0)
    ' IDを選択したのでメインを開き該当IDをTopに表示させる
    Me.Hide
    frmMain.Show
    ' メインの再表示 → メイン側のRefreshで見つかるはず
    MsgBox "ID=" & id & " を検索しました。メインでリフレッシュしてください。"
End Sub
VB

UserForm：frmProgress（コード）

コントロール：lblBar (Label border inside), lblMsg(Label)
単純なバー表示。lblBar はフォーム上で幅を変えて進捗を表現。

' frmProgress code
Option Explicit
' 特別なコードは不要。CProgressBar クラスから制御する想定
VB

AppEntry（標準モジュール：起動点）

アプリの起動／ログイン処理・入口。

' ===== AppEntry =====
Option Explicit

Public Sub RunApp()
    Dim login As New CLogin
    login.Init "admin", "1234" ' ← 必要なら外部化

    Dim f As frmLogin
    Set f = New frmLogin
    Call UI_FormCenter(f)
    f.Show vbModal

    Dim ok As Boolean
    ok = login.Authenticate(f.txtUser, f.txtPass)
    Unload f

    If Not ok Then
        MsgBox "認証に失敗しました。終了します。"
        Exit Sub
    End If

    ' 認証OK：メインフォーム表示
    frmMain.Show
End Sub
VB

RunApp をマクロ一覧から実行、またはブックを開いたときに呼ぶことでアプリが起動します。

起動手順（手順をステップバイステップで）

  1. 新しい Excel ブックを作る。シート名を Data にする。見本データを A1:C3 程度入れておく。
  2. 標準モジュール UI_Common と AppEntry を追加して、それぞれのコードを貼る。
  3. Class Module を追加して CLogin, CRowEditor, CListDetail, CSearchDialog, CProgressBar にコードを貼る。
  4. UserForm を追加して、それぞれのコントロール名を指定どおりに作る（コントロールはプロパティウィンドウで名前を合わせる）。各フォームに示したコードを貼る。
  5. マクロ RunApp を実行（Alt+F8） → ログインダイアログが表示 → 認証成功で frmMain が表示される。
  6. frmMain で一覧を操作（Add/Edit/Delete/Search）する。

サンプルワークフロー（使い方の具体例）

  1. RunApp で起動 → frmLogin に admin/1234 を入力 → OK
  2. 一覧（frmMain）にデータが表示される
  3. 「Add」→ frmDetail で ID/Name/Qty を入力 → Save → 自動追加
  4. 一覧で行を選択→ 「Detail」→ 編集→ Save → 更新される
  5. 一覧で行を選択→ 「Del」→ 削除確認 → 削除
  6. 「Search」→ frmSearch を開きキーワード検索 → 結果表示 → 選択してメインに戻る

拡張ポイント（短く手順）

  • 認証をユーザテーブル（シート）参照にする：CLogin.Authenticate を拡張
  • 大量データ対応：PopulateList をページング化（仮想化）
  • UI の見た目改善：frmMain に列ヘッダ風のラベルを配置 / ListView コントロール採用
  • トランザクション的な編集ログ：編集前の行コピーを別シートへ保存
  • クラス間インターフェース化：IUIComponent を定義して差し替え可能にする

注意点と最後のメモ（実務での使い方）

  • サンプルは小規模業務用のプロトタイプとして動くことを優先しています。大規模データ（数万行）や多人数同時操作が必要な場合は、外部DB化（SQLite／Access／SQLServer）を検討してください。
  • UI をカスタマイズするときは、フォーム上のコントロール名を変えるとコード修正が必要になります。名前は統一しておくと改修が楽です。
  • セキュリティ（パスワード）はハードコードしないこと。実運用ではハッシュ化や外部認証を導入してください。
スポンサーリンク
タイトルとURLをコピーしました