Excel VBA質問箱 IV

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

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


9257 / 13644 ツリー ←次へ | 前へ→

【28269】とある条件のレコードだけ合計が必要な場合 EXCEL_VBA中の下 05/9/1(木) 18:35 質問[未読]
【28272】Re:とある条件のレコードだけ合計が必要な... ponpon 05/9/1(木) 20:39 発言[未読]
【28279】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/1(木) 22:59 発言[未読]
【28390】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 10:59 発言[未読]
【28392】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/5(月) 12:03 発言[未読]
【28393】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 13:37 お礼[未読]

【28269】とある条件のレコードだけ合計が必要な場...
質問  EXCEL_VBA中の下  - 05/9/1(木) 18:35 -

引用なし
パスワード
   よろしくお願いします。
データシート、結果シート、マクロで構成しています。
中分類で結果を出力したいと思っています。

データシート
 大分類、 中分類、  小分類、金額
   服、 紳士服、  紳士服、500
   服、 婦人服、  婦人服、400
   服、 子供服、  子供服、300
   本、 マンガ、  男子向、100
   本、 マンガ、  女子向、150
 飲み物、ジュース、 オレンジ、110
 飲み物、ジュース、 アップル、115
 飲み物、ジュース、 パイン 、120
 飲み物、 お茶系、   麦茶、100
 飲み物、 お茶系、ウーロン茶、100

−マクロ起動−(ここを悩んでいます)

結果シート
   服、 紳士服、500
   服、 婦人服、400
   服、 子供服、300
   本、 マンガ、250
 飲み物、ジュース、345
 飲み物、 お茶系、200

服に関しては中分類で重複しないので、大分類をフィルタで絞込み、
そのまま(必要項目を)コピーで大丈夫なのですが、他のものは中分類で
データを合計しないとダメなので、どうやったらよいかわかりません。
フィルタの条件は大分類までしか操作できません。
(中分類以降は、なにが存在するのかは未知と考えてください)
SUBTOTALなどの関数も考えましたが、
実際のデータでは、中分類のバリエーションがかなり(現在300強)あるので、
ちょっと辛いです。
SQLでの記述方法がわかれば多分、
「SELECT 大分類、中分類、SUM(金額) FROM データシート
 GROUP BY 大分類、中分類」と「FETCH?」

こんな感じだと思うのですが、
どちらも中途半端な知識しか持ち合わせておりませんので・・。(^^;

どなたか、ご教授いただけませんでしょうか?
お返事は明日になると思いますが、よろしくお願いします。

【28272】Re:とある条件のレコードだけ合計が必要...
発言  ponpon  - 05/9/1(木) 20:39 -

引用なし
パスワード
   こんばんは。
確か、前に似たような質問があったような、
ichinoseさんが、回答していたように思います。

私では、
期待には応えられませんが、似たようなことならできます。
中分類をフィルターオプションで抽出し、オートフィルターで処理してます。

シート1がデータシート
シート2が結果シート
データシートのF列を作業列で使用しています。

Sub test()
  
  Dim SH1 As Worksheet
  Dim SH2 As Worksheet
  Dim myR As Range
  Dim myR2 As Range
  Dim myVal As Variant
  
  Set SH1 = Worksheets("sheet1")
  Set SH2 = Worksheets("sheet2")
  Set myR = SH1.Range("A1").CurrentRegion
  Set myR2 = SH1.Range("D2:D" & myR.Rows.Count)
  Application.ScreenUpdating = False
    myR.Columns(2).AdvancedFilter xlFilterCopy, _
            copytorange:=SH1.Range("F1"), unique:=True
    myVal = SH1.Range("F2", SH1.Range("F65536").End(xlUp)).Value
   For i = 1 To UBound(myVal, 1)
    With myR
     .AutoFilter field:=2, Criteria1:=myVal(i, 1)
     .Offset(1, 0).Resize(myR.Rows.Count - 1, myR.Columns.Count).Copy _
      SH2.Range("A65536").End(xlUp).Offset(3, 0)
      
      With SH2.Range("C65536").End(xlUp).Offset(1, 0)
       .Value = "合計"
       .Font.Bold = True
       .Offset(0, 1).Value = Application.Subtotal(9, myR2)
       .Offset(0, 1).Font.Bold = True
      End With
    
     .AutoFilter
    End With
    Next
  SH1.Range("F:F").ClearContents
  Application.ScreenUpdating = True

【28279】Re:とある条件のレコードだけ合計が必要...
発言  ichinose  - 05/9/1(木) 22:59 -

引用なし
パスワード
   EXCEL_VBA中の下 さん、
ponponさん、こんばんは。


>データシート
というシート名を持ったシートに
以下のデータがセルA列からD列の1行目から入っているとします。

> 大分類、 中分類、  小分類、金額
>   服、 紳士服、  紳士服、500
>   服、 婦人服、  婦人服、400
>   服、 子供服、  子供服、300
>   本、 マンガ、  男子向、100
>   本、 マンガ、  女子向、150
> 飲み物、ジュース、 オレンジ、110
> 飲み物、ジュース、 アップル、115
> 飲み物、ジュース、 パイン 、120
> 飲み物、 お茶系、   麦茶、100
> 飲み物、 お茶系、ウーロン茶、100
>

>
>結果シート
というシート名を持ったシートを作成して置いてください。


>SQLでの記述方法がわかれば多分、
>「SELECT 大分類、中分類、SUM(金額) FROM データシート
> GROUP BY 大分類、中分類」と「FETCH?」
これは、色んな方法があると思いますが、
いけそうなSQLが記述されているので
これを使いましょう!!

上記の二つのシートを持ったブックの
標準モジュールに

'=======================================================
Sub test()
  Dim rs As Object
  Dim mysql As String
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "select [大分類],[中分類],sum([金額]) from [データシート$] group by [大分類],[中分類]"
    If get_exec_sql(mysql, rs) = 0 Then
     With Worksheets("結果シート")
      .Cells.ClearContents
      .Range("a1").CopyFromRecordset rs
      .Range("a1:c1").Value = Array("大分類", "中分類", "金額")
      End With
     Call rs_close(rs)
    Else
     MsgBox "rs error"
     End If
    Call close_ado
  Else
    MsgBox "cn error"
    End If
End Sub


別の標準モジュールに
'======================================================
Public cn As Object
'======================================================
Function open_ado_excel(book_fullname As String) As Long
  On Error Resume Next
  link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & book_fullname & ";" & _
       "Extended Properties=Excel 8.0;"
  Set cn = CreateObject("ADODB.Connection")
  cn.Open link_opt
  open_ado_excel = Err.Number
  On Error GoTo 0

End Function
'======================================================
Sub close_ado()
  On Error Resume Next
  cn.Close
  On Error GoTo 0
End Sub
'======================================================
Function get_exec_sql(sql_str, rs As Object) As Long
  On Error Resume Next
  Set rs = cn.Execute(sql_str)
  get_exec_sql = Err.Number
  On Error GoTo 0
End Function
'======================================================
Sub rs_close(rs As Object)
  On Error Resume Next
  rs.Close
  On Error GoTo 0
End Sub


以上です。
一度このブックを保存してから

プロシジャーtestを実行して見て下さい。

【28390】Re:とある条件のレコードだけ合計が必要...
発言  EXCEL_VBA中の下  - 05/9/5(月) 10:59 -

引用なし
パスワード
   ponponさん、ichinoseさん
ご説明ありがとうございました。

自分でSQLのことを言っていたので、
今回はichinoseさんのものを使って試してみました。

結果なのですが、get_exec_sqlがエラーで動きませんでした。
リターンコードは"-2147217904"でした。

  Dim rs As Object
  Dim mysql As String
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "Select [YYYY],[MM],[CODE_A],[CODE_B],[CODE_C],[CODE_D],sum([KINGAKU]) " & _
        " from [DATA$] " & _
        " Where [FLG] = '1' AND [CODE_D] = '03' " & _
        " group by [YYYY],[MM],[CODE_A],[CODE_B],[CODE_C],[CODE_D] "
    If get_exec_sql(mysql, rs) = 0 Then
     With Worksheets("WORK")
      .Cells.ClearContents
      .Range("a1").CopyFromRecordset rs
      .Range("a1:g1").Value = Array("YYYY", "MM", "CODE_A", "CODE_B", "CODE_C", "CODE_D", "KINGAKU")
      End With
     Call rs_close(rs)
    Else
     MsgBox "rs error"  ←ここに来ます。
     End If
    Call close_ado
  Else
    MsgBox "cn error"
  End If
(他の部分はichinoseさんの記述のまま使用しています。)

なにか基本的な設定が足りないのでしょうか?
質問時はSQL文を少し(Where句、項目数)削り記載しましたが、
今回のSQLは実際のものです。
開発はXP(Excel2002)、使用するのは2000(Excel2000)です。
エラーは開発環境で出ています。
よろしくお願いします。

【28392】Re:とある条件のレコードだけ合計が必要...
発言  ichinose  - 05/9/5(月) 12:03 -

引用なし
パスワード
   ▼EXCEL_VBA中の下 さん:
こんにちは。
まず、ADOのI/Oプロシジャーの一部を
'================================
Function get_exec_sql(sql_str, rs As Object) As Long
  On Error Resume Next
  Set rs = cn.Execute(sql_str)
  get_exec_sql = Err.Number
  If Err.Number <> 0 Then
    MsgBox Err.Number & "::" & Err.Description
    End If
  On Error GoTo 0
End Function
と詳しいエラーが表示されるように変更して下さい。


>
>自分でSQLのことを言っていたので、
>今回はichinoseさんのものを使って試してみました。
>
>結果なのですが、get_exec_sqlがエラーで動きませんでした。
>リターンコードは"-2147217904"でした。
>
>  Dim rs As Object
>  Dim mysql As String
>  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
>    mysql = "Select [YYYY],[MM],[CODE_A],[CODE_B],[CODE_C],[CODE_D],sum([KINGAKU]) " & _
>        " from [DATA$] " & _
>        " Where [FLG] = '1' AND [CODE_D] = '03' " & _
>        " group by [YYYY],[MM],[CODE_A],[CODE_B],[CODE_C],[CODE_D] "
>    If get_exec_sql(mysql, rs) = 0 Then
>     With Worksheets("WORK")
>      .Cells.ClearContents
      .Range("a2").CopyFromRecordset rs '一箇所訂正 a2でした
>      .Range("a1:g1").Value = Array("YYYY", "MM", "CODE_A", "CODE_B", "CODE_C", "CODE_D", "KINGAKU")
>      End With
>     Call rs_close(rs)
     Else '呼び出し側でエラー表示するので不要になりました
      MsgBox "rs error"  ←これも・・・
>      End If
>    Call close_ado
>  Else
>    MsgBox "cn error"
>  End If
>(他の部分はichinoseさんの記述のまま使用しています。)

として実行してみて下さい


SQLの記述に問題があると思います。

私が疑っているのは

>        " Where [FLG] = '1' AND [CODE_D] = '03' " & _

この行です。と言ってサンプルを提示されていないので感ですが・・。

''で囲むのは文字列です。FLGという列の書式は文字列なんですか?
CODE_Dも同様です。

FLGという列の書式が標準で上記のSQLでは 型が一致しないというエラーが出ます。

確認して下さい。


>なにか基本的な設定が足りないのでしょうか?
>質問時はSQL文を少し(Where句、項目数)削り記載しましたが、
>今回のSQLは実際のものです。
>開発はXP(Excel2002)、使用するのは2000(Excel2000)です。
>エラーは開発環境で出ています。
↑こんなクロスコンパイラーのような事がVBAで大丈夫なんですか?
私なら、使用するExcel2000で作成も行いますが・・・。

【28393】Re:とある条件のレコードだけ合計が必要...
お礼  EXCEL_VBA中の下  - 05/9/5(月) 13:37 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。よろしくお願いします。
結論から申し上げますと、うまく動きました。

>        " Where [FLG] = '1' AND [CODE_D] = '03' " & _
>''で囲むのは文字列です。FLGという列の書式は文字列なんですか?
 [FLG]は数値でした。''は必要ないのですね。 
 型式が影響しているとは思いませんでした。大変失礼しました。

あと、シート名(テーブル名)を変数で扱いたいと思って
質問しようと思いましたが、
試行錯誤していたら、自己解決しました。

DIM Sheet_NM as String
  Sheet_NM="DATA"

  "Select ・・・  from [" & Sheet_NM & "$]"

正しく動いたので大丈夫ですよね?(^^;

>
>>なにか基本的な設定が足りないのでしょうか?
>>質問時はSQL文を少し(Where句、項目数)削り記載しましたが、
>>今回のSQLは実際のものです。
>>開発はXP(Excel2002)、使用するのは2000(Excel2000)です。
>>エラーは開発環境で出ています。
>↑こんなクロスコンパイラーのような事がVBAで大丈夫なんですか?
>私なら、使用するExcel2000で作成も行いますが・・・。
 確かにおっしゃる通りです。
 動作確認したいと思います。

 実際に使用する環境と同じ環境で開発・テストするのが一般的ですね。
 不安定な?環境下での質問でスミマセンでした。m(_ _)m

ありがとうございました。

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