EXCELとACCESSを使った運用 Part.2
EXCELとACCESSを使った運用 Part.1からの続きです。
今回はACCESSに入っているデータを、EXCELに抽出します。
ざっくり説明します。
Accessはデータベース管理システムのソフトウェアです。容量等に制限があり、あまり大きなデータは向きません。
一件のデータの大きさにもよりますが、数百万件程度ぐらいなら大丈夫だと思います。
以下の例は、AccessへSQLを使用して、EXCEL側へ対象日付のデータを抽出するEXCELマクロです。
そのまま抽出と、集計して抽出するマクロを掲載しています。
SQLってなんぞな？って方もいらっしゃいますよね。
今回の例題はそれほど難しいものではありません。SQLになじみのない方は、access側で、クエリを作成して、作成したデザインをSQLビューで見ると、SQL文が見えます。
※EXCEL側と少し書き方が違うところがありますので、そこはググってください。
日付指示がない場合は、クエリを作っておいて、マクロを使わないでそのまま抽出することも可能です。
・データー/ACCESSデーターベースをクリック
・対象ACCESSDBを選択…
今回はここまで。
そのまま抽出
If IsDate(NEW_SDATE) = False Then
MsgBox ("スタート日付を正しく入力してください"), vbCritical
Exit Sub
End If
If IsDate(NEW_EDATE) = False Then
MsgBox ("エンド日付を正しく入力してください"), vbCritical
Exit Sub
End If
If NEW_SDATE > NEW_EDATE Then
MsgBox ("日付の範囲がおかしいです"), vbCritical
Exit Sub
End If
MSG_FLG = MsgBox("accessDB取込( " & NEW_SDATE & " ～ " & NEW_EDATE & " )実行OK?", vbYesNo)
If MSG_FLG = vbNo Then
Exit Sub
End If
'@@@@@@@@ 対象 ACCESS OPEN @@@@@@@@@
Const cnsTITLE = "○access抽出（*.mdb）処理"
Const cnsFILTER = "新コレクトから (*.accdb),*.accdb"
With CreateObject("WScript.Shell")
.CurrentDirectory = Worksheets("KANRI").Range("B1") '@@ シート設定
End With
vFILENAME = Application.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE)
If VarType(vFILENAME) = vbBoolean Then
MsgBox ("キャンセル")
Exit Sub
End If
dbFile = vFILENAME
myCon.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbFile & ""
myCon.Open
mySQL = "SELECT DATA.顧客コード, DATA.顧客名, DATA.出荷日, DATA.商品コード, DATA.商品名, DATA.金額, DATA.冊数 AS [冊数 の 合計] FROM data "
mySQL = mySQL & "WHERE (DATA.出荷日 >= " & " #" & NEW_SDATE.Text & "# And DATA.出荷日" & " <= #" & NEW_EDATE.Text & "#) "
'###### SQL 保存 ######
Worksheets("KANRI").Range("B21") = mySQL
'###### SQL 発行 ######
myRecordSet.Open mySQL, myCon, adOpenDynamic
'###### excelへ展開 ######
mySheetName = "PICUP1"
'※※※※※※オートフィルター解除 ※※※※※※
If Sheets(mySheetName).AutoFilterMode Then
Sheets(mySheetName).Range("A1").AutoFilter
End If
'###クリア処理 ###
Sheets(mySheetName).Select
Cells.Select
Selection.ClearContents
'### ヘダー作成 ###
With Worksheets(mySheetName)
.Cells(1, 1).Value = "顧客コード"
.Cells(1, 2).Value = "顧客名"
.Cells(1, 3).Value = "出荷日"
.Cells(1, 4).Value = "商品コード"
.Cells(1, 5).Value = "商品名"
.Cells(1, 6).Value = "金額"
.Cells(1, 7).Value = "冊数"
End With
'### 明細作成 ###
ILONG = 2
Do Until myRecordSet.EOF
With Worksheets(mySheetName)
.Cells(ILONG, 1).Value = myRecordSet(0)
.Cells(ILONG, 2).Value = myRecordSet(1)
.Cells(ILONG, 3).Value = myRecordSet(2)
.Cells(ILONG, 4).Value = myRecordSet(3)
.Cells(ILONG, 5).Value = myRecordSet(4)
.Cells(ILONG, 6).Value = myRecordSet(5)
.Cells(ILONG, 7).Value = myRecordSet(6)
End With
ILONG = ILONG + 1
myRecordSet.MoveNext
Loop
'### CLOSE ###
myRecordSet.Close
Set myRecordSet = Nothing
myCon.Close
Set myCon = Nothing
Range("A1").Select
MsgBox (" 抽出終了 ")
Application.StatusBar = " AccessDB抽出ＥＮＤ "
End Sub
集計して抽出
If IsDate(NEW_SDATE) = False Then
MsgBox ("スタート日付を正しく入力してください"), vbCritical
Exit Sub
End If
If IsDate(NEW_EDATE) = False Then
MsgBox ("エンド日付を正しく入力してください"), vbCritical
Exit Sub
End If
If NEW_SDATE > NEW_EDATE Then
MsgBox ("日付の範囲がおかしいです"), vbCritical
Exit Sub
End If
MSG_FLG = MsgBox("accessDB取込( " & NEW_SDATE & " ～ " & NEW_EDATE & " )実行OK?", vbYesNo)
If MSG_FLG = vbNo Then
Exit Sub
End If
'@@@@@@@@ 対象 ACCESS OPEN @@@@@@@@@
Const cnsTITLE = "○access抽出（*.mdb）処理"
Const cnsFILTER = "新コレクトから (*.accdb),*.accdb"
With CreateObject("WScript.Shell")
.CurrentDirectory = Worksheets("KANRI").Range("B1") '@@ シート設定
End With
vFILENAME = Application.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE)
If VarType(vFILENAME) = vbBoolean Then
MsgBox ("キャンセル")
Exit Sub
End If
dbFile = vFILENAME
myCon.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbFile & ""
myCon.Open
mySQL = "SELECT DATA.顧客コード, DATA.顧客名, DATA.出荷日, Sum(DATA.金額) AS 金額の合計, Sum(DATA.冊数) AS 冊数の合計 FROM data "
mySQL = mySQL & "WHERE (DATA.出荷日 >= " & " #" & NEW_SDATE.Text & "# And DATA.出荷日" & " <= #" & NEW_EDATE.Text & "#) "
mySQL = mySQL & "GROUP BY DATA.顧客コード, DATA.顧客名, DATA.出荷日;"
'###### SQL 保存 ######
Worksheets("KANRI").Range("B22") = mySQL
'###### SQL 発行 ######
myRecordSet.Open mySQL, myCon, adOpenDynamic
'###### excelへ展開 ######
mySheetName = "PICUP2"
'※※※※※※オートフィルター解除 ※※※※※※
If Sheets(mySheetName).AutoFilterMode Then
Sheets(mySheetName).Range("A1").AutoFilter
End If
'###クリア処理 ###
Sheets(mySheetName).Select
Cells.Select
Selection.ClearContents
'### ヘダー作成 ###
With Worksheets(mySheetName)
.Cells(1, 1).Value = "顧客コード"
.Cells(1, 2).Value = "顧客名"
.Cells(1, 3).Value = "出荷日"
.Cells(1, 4).Value = "金額の合計"
.Cells(1, 5).Value = "冊数の合計"
End With
'### 明細作成 ###
ILONG = 2
Do Until myRecordSet.EOF
With Worksheets(mySheetName)
.Cells(ILONG, 1).Value = myRecordSet(0)
.Cells(ILONG, 2).Value = myRecordSet(1)
.Cells(ILONG, 3).Value = myRecordSet(2)
.Cells(ILONG, 4).Value = myRecordSet(3)
.Cells(ILONG, 5).Value = myRecordSet(4)
End With
ILONG = ILONG + 1
myRecordSet.MoveNext
Loop
'### CLOSE ###
myRecordSet.Close
Set myRecordSet = Nothing
myCon.Close
Set myCon = Nothing
Range("A1").Select
MsgBox (" 抽出終了 ")
Application.StatusBar = " AccessDB抽出ＥＮＤ "
End Sub