小さい会社の1人SEの開発記というか奮戦記

「SQL Server Express と ADO、Excel と VBA を使って課題管理表を作ってみよう」の最新取得ボタンをクリックしたときの処理について説明します。

考え方

1. シートにあるデータをクリアする
2. データを検索する。Noの最新データのみ表示する
3. レコードセットをシートに貼り付ける
4. レコードの最大行を基準にし罫線を引く
5. バッチのプルダウンを設定する
6. 完了日が入っていれば行をグレーアウトする

プログラムのポイント

基本的なところは主に「SQL-Excelサンプル 課題管理表全件表示ボタンを押したときの処理」で説明していますのでそちらを参照して下さい。こちらは最新データを抽出する処理を中心に説明します。

サブクエリ―を使って同一Noの最新データのみ抽出する

言葉で言うと同じナンバーで ID = Max(ID) のものになります。実際に作成したSQL文は以下の通りです。

“SELECT * FROM T_課題管理表 AS AA WHERE (ID = (SELECT MAX(ID) FROM T_課題管理表 WHERE (AA.No = No))) ORDER BY No”

テーブルを AA と設定してWHERE句の中で AA.No = No と使います。

バッチのプルダウンを設定する

バッチの部分には「追加」「更新」「削除」を選択できる様にデータの入力規則を設定します。(マクロの記録で拾いました。)

Cells(3, 3).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=”追加,更新,削除”
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = “”
.ErrorTitle = “”
.InputMessage = “”
.ErrorMessage = “”
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

完了日が入っていれば行をグレーアウトする

Selection.Interior を使って色を設定します。

i2 = Cells(Cells.Rows.Count, 2).End(xlUp).Row ‘B列最終行
：
For i1 = 3 To i2
If Cells(i1, 11).Value <> “” Then
Range(“B4:K4”).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
End If
Next

実際に作成したプログラム

Sub 最新取得_Click()
    '   変数宣言
    Dim i1, i2, i3 As Long      'カウンタ
    Dim ADO_RS As Object        'レコードセットオブジェクト
    Dim TXT_SQ As String        'SQL文

    '   過去データ削除処理
    i2 = Cells(Cells.Rows.Count, 2).End(xlUp).Row   'B列最終行
    
    If i2 > 2 Then
        Rows("3:" & i2 + 5).Select
        Selection.Delete Shift:=xlUp
    End If
    
    '   データベース処理
    Call connect                 'データベース接続
    TXT_SQ = "SELECT * FROM T_課題管理表 AS AA WHERE (ID = (SELECT MAX(ID) FROM T_課題管理表 WHERE (AA.No = No))) ORDER BY No"
    Set ADO_RS = CreateObject("ADODB.Recordset")
    ADO_RS.Open TXT_SQ, ADO_CN
    
    i1 = 3
    Do Until ADO_RS.EOF
        Cells(i1, 2).Value = ADO_RS("No")
        Cells(i1, 4).Value = ADO_RS("分類")
        Cells(i1, 5).Value = ADO_RS("課題")
        Cells(i1, 6).Value = ADO_RS("対応進捗")
        Cells(i1, 7).Value = ADO_RS("担当者")
        Cells(i1, 8).Value = ADO_RS("責任者")
        If IsNull(ADO_RS("更新日")) Then
            Cells(i1, 9).Value = ""
        Else
            Cells(i1, 9).Value = CDate(ADO_RS("更新日"))
        End If
        If IsNull(ADO_RS("完了予定日")) Then
            Cells(i1, 10).Value = ""
        Else
            Cells(i1, 10).Value = CDate(ADO_RS("完了予定日"))
        End If
        If IsNull(ADO_RS("完了日")) Then
            Cells(i1, 11).Value = ""
        Else
            Cells(i1, 11).Value = CDate(ADO_RS("完了日"))
        End If
        
        i1 = i1 + 1
        ADO_RS.MoveNext
    Loop
    
    ADO_RS.Close
    Set ADO_RS = Nothing
    
    Call disconnect             'データベース接続解除
    
    MsgBox "検索が完了しました。"
    
    '   罫線を引く
    i2 = Cells(Cells.Rows.Count, 2).End(xlUp).Row   'B列最終行
    Range("B3:K" & i2 + 5).Borders.LineStyle = True
  
    '   セル折り返し処理
    Range("E3:F" & i2 + 5).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    '   プルダウン追加
    Cells(3, 3).Select
        With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="追加,更新,削除"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    Selection.Copy
    Range("C3:C" & i2 + 5).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    '   終了日<>"" でグレーアウト
    For i1 = 3 To i2
        If Cells(i1, 11).Value <> "" Then
            Range("B4:K4").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.249977111117893
                .PatternTintAndShade = 0
            End With
        End If
    Next

    Cells(1, 1).Select

End Sub

まとめ

今回のポイントは「同じナンバーで ID = Max(ID) のものを抽出する。」ことです。WHERE句の中にサブクエリ―を使う方法で履歴管理を行わなければいけない時によく使いますので覚えておいて損は無いと思います。

課題管理表のサンプルについての説明は以上になります。ここまで読んでいただきありがとうございます。次の記事でダウンロード先と使い方についてまとめます。

前の記事 →「SQL-Excelサンプル 課題管理表全件表示ボタンを押したときの処理」