【EXCEL】EXCELだけでSQL

「EXCELのSQL」

DB(ACCESS)を使わないでEXCELのみでSQL文を利用しました。

EXCELのピボット機能を使っても集計は簡単にできますが、

少し変則な集計表にするとか、凝った集計表するにはピボットでは難しいので

次のプログラミングしました。

下記にサンプルを記述します。

１．表（excel）を準備

f:id:hide_kichi:20220307131107p:plain

２．マクロ稼働環境を設定

　（１）Excelのメニューに「開発」メニューを追加します。

f:id:hide_kichi:20220307130833p:plain

f:id:hide_kichi:20220307130942p:plain

　（２）マクロの環境設定をします。
　　　　「ツール」―「参照」で以下の設定をします。

f:id:hide_kichi:20220307131029p:plain

3．プログラム作成

　　（１）サンプル1



Public Sub SAMPLE1()

       
    Const adOpenKeyset = 1
    Const adLockReadOnly = 1
 
    Dim CON      As Object
    Dim RDS       As Object
    Dim SQL_1    As String
    
    work_s = ActiveWorkbook.Name
    Set BOOK_THIS = Application.Workbooks(work_s)    'サンプルデータ2.xlsm

    MsgBox BOOK_THIS.Name
    
     
    Set CON = CreateObject("ADODB.Connection")
    Set RDS = CreateObject("ADODB.Recordset")
    CON.Provider = "Microsoft.ACE.OLEDB.12.0"
    
    CON.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
 
    CON.Open BOOK_THIS.FullName    'サンプルデータ2.xlsm
                                         
    作業日付1 = "2020/5/01"
    作業日付2 = "2020/6/30"
  


    BOOK_THIS.Worksheets("日報データ").Select
  
  
    'sql文作成

   
            
                
                work_s = " SELECT * FROM  [日報データ$C1:J20000]   WHERE "
'
                work_s = work_s & " [作業者]= '"
                work_s = work_s & "作業者Ｈ" & "' "
                
                work_sel = work_s
       
                SQL_1 = work_sel

    'sql実行
    
    RDS.Open SQL_1, CON, adOpenKeyset, adLockReadOnly
 
    Application.ScreenUpdating = False
    
   
    '検索結果をシート"RESULT"にデータを出力する
    BOOK_THIS.Worksheets("RESULT").Range("C2").Offset(0, 0).CopyFromRecordset RDS
    
    Application.ScreenUpdating = True
    
    MsgBox RDS.RecordCount & "件取得しました。"

    BOOK_THIS.Worksheets("RESULT").Select
    




End Sub

　　（２）サンプル２
　　　
'作業日付が "2020/5/01"～"2020/6/30"のデータで
'作業者が作業者H､場所がX棟orA棟で
'枚数10枚以上で時数10h以上のデータを抽出



Public Sub SAMPLE2()

       
    Const adOpenKeyset = 1
    Const adLockReadOnly = 1
 
    Dim CON      As Object
    Dim RDS       As Object
    Dim SQL_1    As String
    
    work_s = ActiveWorkbook.Name
    Set BOOK_THIS = Application.Workbooks(work_s)    'サンプルデータ2.xlsm

      
     
    Set CON = CreateObject("ADODB.Connection")
    Set RDS = CreateObject("ADODB.Recordset")
    CON.Provider = "Microsoft.ACE.OLEDB.12.0"
    
    CON.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
 
    CON.Open BOOK_THIS.FullName    'サンプルデータ2.xlsm
                                         
  作業日付1 = "2020/5/01"
  作業日付2 = "2020/6/30"
  
    


    BOOK_THIS.Worksheets("日報データ").Select
  
  
    'sql文作成

  
    
    '作業日付が "2020/5/01"～"2020/6/30"のデータで
    '作業者が作業者H､場所がX棟orA棟で
    '枚数１０枚以上で時数10h以上のデータを抽出

  
            
                
                work_s = " SELECT * FROM  [日報データ$C1:J20000]   WHERE "
'
                work_s = work_s & " [作業者]= '"
                work_s = work_s & "作業者Ｈ" & "' and "
'
'
                work_s = work_s & " ( [場所]= '"
                work_s = work_s & "X棟" & "'  "
                work_s = work_s & " OR  [場所]= '"
                work_s = work_s & "A棟" & "'  ) AND "
'
                work_s = work_s & " ( [枚数]>= 10"
                work_s = work_s & " and  [時数]>= 10 ) and"
                work_s = work_s & " 作業日付 >="
                work_s = work_s & "#" & 作業日付1 & "#  and "
                work_s = work_s & " 作業日付 <="
                work_s = work_s & "#" & 作業日付2 & "#   "     
       
                'work_s = work_s & order_s1
                
                work_sel = work_s
       
                SQL_1 = work_sel

    'sql実行
    
    RDS.Open SQL_1, CON, adOpenKeyset, adLockReadOnly
 
    Application.ScreenUpdating = False
    
    BOOK_THIS.Worksheets("RESULT").Range("C2:J30000") = ""
    '検索結果をシート"RESULT"にデータを出力する
    BOOK_THIS.Worksheets("RESULT").Range("C2").Offset(0, 0).CopyFromRecordset RDS
    
    Application.ScreenUpdating = True
    
    MsgBox RDS.RecordCount & "件取得しました。"

    BOOK_THIS.Worksheets("RESULT").Select
    


End Sub