まりふのひと

ExcelでSQLが使えるか(2)…完成

Excel VBA

「ExcelでSQLが使えるか」では検索した結果をセルに貼り付けるSQLだった。

  1. 「表を貼り付ける」のが目的だったので、試行錯誤した ‥‥ が、できない。
  2. モーグ を“Excel SQL” で検索してみたが、Excel から Access のデータを取得するトピックはあったものの、「Excel から Excel」は見つけられなかった。
  3. “Excel DAO”でググる。

田布施町施設予約の解析手順

これは、9月22日に行った 田布施町 施設予約の解析 の完全 Excel 版。

  1. 田布施町役場ホームページ > 施設予約 から、［予約確認］に入る。
  2. ID. およびパスワードを入力する。
  3. 表示されたページの表を選択し、Excel に貼り付ける。

    • 貼り付けた後、［貼り付け先の書式に合わせる］。
    • Ａ列は、元々の表に項目名が無いので、適当に入力した。
      　これは、リスト形式にするためで、削除しても問題ない。
    • 書式の設定は見やすくするためにコピペ後 行った。
  4. シート名を“Source”にする。（シート名［Source］に貼り付けてもよい）
  5. シート名を“Step1”を作成する。
  6. 「Macro1」を実行する。
    • Macro1で出来る表。
    • A〜C列は、［Source］シートのデータそのもの。D〜F列はマクロで作ったデータ。
  7. シート名を“Step2”を作成する。
  8. 「Macro2」を実行する。
    • ［Step1］シートからMacro2で作ったデータ（AおよびB列）。
    • 書式の設定は、後から手で行ったもの。
  9. ［Step2］シートの表に手を加える
    1. Weekday： 「利用日」から週のコードを取り出す。セルC2は、“=weekday(a2)”
    2. 日差： 前回の「利用日」との日数の差。セルD2は、“=a2-a1”
    3. 「Weekday」「利用日」を昇順で並べ替える。
    4. 「Weekday」の変わり目の「日差」（例えば セルD2）は「意味なし」のためクリアする。
    5. 「日差」のD列は、条件付き書式設定してある。
      • セルの値が8〜30であれば、フォントを太字の橙色にする。
  10. 考察する（「備考」のE列）
    • 毎週予約してあれば、「日差」は 7 になるはず。
    • 「日差」が 7 でない理由を「備考」に入れる。

マクロ

参照設定と完成したマクロ。

※ 参照設定


「Microsoft DAO 3.6 Object Library」を追加した。

※ Macro1
Sub Macro1()
On Error GoTo Err_Macro1
Dim DBS As DAO.Database
Dim RST As DAO.Recordset
Dim i As Long
Dim xlsFile As String
Dim strSQL As String

    strSQL = "SELECT 利用日,開始,終了,CDate(Left([開始],5)) AS 開始時刻" _
            & ",CDate(Right([終了],5)) AS 終了時刻" _
            & ",DateDiff('n',[開始時刻],[終了時刻]) AS 予約時間" _
            & " FROM [Source$]" _
            & " WHERE (([利用日] >= #4/1/2009#) And ([開始] <> '18：00〜20：00'))" _
            & " ORDER BY 利用日, 開始, 終了"
    xlsFile = ThisWorkbook.FullName    'ブックのフルパス
    Set DBS = OpenDatabase(xlsFile, False, False, "EXCEL 8.0;HDR=YES;")
    Set RST = DBS.OpenRecordset(strSQL, dbOpenForwardOnly)
    With Worksheets("Step1")
            'タイトル行
        For i = 0 To RST.Fields.Count - 1
            .Cells(1, i + 1).Value = RST.Fields(i).Name
        Next
            'データの貼り付け
        .Range("A2").CopyFromRecordset RST
    End With
    RST.Close

Exit_Macro1:
    Set RST = Nothing
    Set DBS = Nothing
    Exit Sub

Err_Macro1:
    MsgBox Err.Number & "/" & Err.Description, vbCritical
    Resume Exit_Macro1
End Sub

※ Macro2
Sub Macro2()
On Error GoTo Err_Macro2
Dim DBS As DAO.Database
Dim RST As DAO.Recordset
Dim i As Long
Dim xlsFile As String
Dim strSQL As String

    strSQL = "Select 利用日, Sum(予約時間) as 予約時間計 from [Step1$]" _
            & " Group by 利用日"
    xlsFile = ThisWorkbook.FullName    'ブックの指定
    Set DBS = OpenDatabase(xlsFile, False, False, "EXCEL 8.0;HDR=YES;")
    Set RST = DBS.OpenRecordset(strSQL, dbOpenForwardOnly)
    With Worksheets("Step2")
            'タイトル行
        For i = 0 To RST.Fields.Count - 1
            .Cells(1, i + 1).Value = RST.Fields(i).Name
        Next
            'データの貼り付け
        .Range("A2").CopyFromRecordset RST
    End With
    RST.Close

Exit_Macro2:
    Set RST = Nothing
    Set DBS = Nothing
    Exit Sub

Err_Macro2:
    MsgBox Err.Number & "/" & Err.Description, vbCritical
    Resume Exit_Macro2
End Sub