Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


66655 / 76734 ←次へ | 前へ→

【14642】Re:データベースイメージ(SQL)
発言  ichinose  - 04/6/3(木) 18:52 -

引用なし
パスワード
   ▼レッサーパンダ さん、Jカーターさん
こんばんは。


>実は質問の内容があまりよくなかったみたいです・・。
>
>DCOUNTとDSUMを知らなかったのは事実ですが、
>本当は結果より過程を知りたかったんです。
>SQLやVBAを使用して結果を求められるのかを知りたかったんです。
>確かにあの質問の内容からだと、
>SQLやVBAを使用しなくてもDCOUNTとDSUMで出来てしまいますね。

なるほど・・・。
すでにJカーターさんからDAOでの回答が付いていますが・・・。
私は、ADOで別解です。

前回の関数のときのようなシートレイアウトだとして、
標準モジュールに
'==================================================================
Sub main()
  Dim rs As Object
  Dim sql As String
  Dim cond() As String
  Dim retcode As Long
  If open_excel(ThisWorkbook.FullName) = 0 Then 'Excelに接続成功
   sql = "select count(*),sum(所持金) from [sheet2$] "
   idx = 0
   With Worksheets("sheet1")
     If .Range("a2").Value <> "" Then
      ReDim Preserve cond(1 To idx + 1)
      cond(idx + 1) = "年齢 = " & .Range("a2").Value
      idx = idx + 1
      End If
     If .Range("b2").Value <> "" Then
      ReDim Preserve cond(1 To idx + 1)
      cond(idx + 1) = "性別 = '" & .Range("b2").Value & "'"
      idx = idx + 1
      End If
     If idx > 0 Then
      sql = sql & "where " & Join(cond(), " and ")
      End If
'---------sqlの構文の決定
     Set rs = get_rs(sql, retcode) '人数と所持金合計の算出
     If retcode = 0 Then
      .Range("a4").Value = rs.Fields(0).Value
      .Range("b4").Value = rs.Fields(1).Value
      rs.Close
      Set rs = Nothing
     Else
      MsgBox Error(retcode)
      End If
     Call close_excel
     End With
   End If
End Sub

'別の標準モジュールに
'================================================================
Public cn As Object
'================================================================
Function open_excel(flnm) As Long
  On Error Resume Next
  Set cn = CreateObject("adodb.connection")
  link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & flnm & ";" & _
       "Extended Properties=Excel 8.0;"
  cn.Open link_opt
  open_excel = Err.Number
  On Error GoTo 0
End Function
'==============================================================
Function close_excel()
  On Error Resume Next
  cn.Close
  Set cn = Nothing
End Function
'==============================================================
Function get_rs(sql_str, retcode) As Object
  On Error Resume Next
  Set get_rs = Nothing
  Set get_rs = cn.Execute(sql_str)
  retcode = Err.Number
  On Error GoTo 0
End Function


これで前回の関数のときのように
Sheet1のセルA2には、年齢条件、B2に性別条件を入力して、mainを
実行してみて下さい(未入力の場合は、条件なしとみなします)。
このコードは参照設定は不要ですが、私、普段はしています。
よかったら、確認してみて下さい。

0 hits

【14596】データベースイメージ(SQL) レッサーパンダ 04/6/2(水) 17:16 質問
【14601】Re:データベースイメージ(SQL) ichinose 04/6/2(水) 18:26 回答
【14621】Re:データベースイメージ(SQL) レッサーパンダ 04/6/3(木) 10:21 お礼
【14622】Re:データベースイメージ(SQL) Jカーター 04/6/3(木) 10:34 回答
【14642】Re:データベースイメージ(SQL) ichinose 04/6/3(木) 18:52 発言
【14798】Re:データベースイメージ(SQL) レッサーパンダ 04/6/8(火) 10:04 お礼
【14853】Re:データベースイメージ(SQL) ichinose 04/6/8(火) 21:18 発言

66655 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free