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

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

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

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

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

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

    • 貼り付けた後、[貼り付け先の書式に合わせる]。
    • A列は、元々の表に項目名が無いので、適当に入力した。
       これは、リスト形式にするためで、削除しても問題ない。
    • 書式の設定は見やすくするためにコピペ後 行った。
  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