Excel VBA質問箱 IV

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

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


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

【41860】データの集計方法について教えて下さい K.K 06/8/24(木) 15:42 質問[未読]
【41862】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 15:52 発言[未読]
【41863】Re:データの集計方法について教えて下さい K.K 06/8/24(木) 16:19 発言[未読]
【41864】Re:データの集計方法について教えて下さい K.K 06/8/24(木) 16:30 発言[未読]
【41865】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 16:34 回答[未読]
【41866】Re:データの集計方法について教えて下さい K.K 06/8/24(木) 17:07 お礼[未読]
【41868】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 17:42 発言[未読]
【41869】Re:データの集計方法について教えて下さい kazuo 06/8/24(木) 18:18 発言[未読]
【41873】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 19:53 回答[未読]
【41874】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 19:57 発言[未読]
【41871】Re:データの集計方法について教えて下さい Ned 06/8/24(木) 18:58 発言[未読]
【41875】Re:データの集計方法について教えて下さい かみちゃん 06/8/24(木) 19:59 発言[未読]
【41876】Re:データの集計方法について教えて下さい Ned 06/8/24(木) 20:32 発言[未読]
【41889】Re:データの集計方法について教えて下さい kobasan 06/8/24(木) 23:11 発言[未読]
【41892】Re:データの集計方法について教えて下さい k.k 06/8/25(金) 10:54 お礼[未読]
【41912】Re:データの集計方法について教えて下さい jun 06/8/26(土) 2:25 質問[未読]
【41913】Re:データの集計方法について教えて下さい Ned 06/8/26(土) 2:32 発言[未読]
【41914】Re:データの集計方法について教えて下さい jun 06/8/26(土) 2:41 発言[未読]
【41915】Re:データの集計方法について教えて下さい Ned 06/8/26(土) 4:06 発言[未読]
【41923】Re:データの集計方法について教えて下さい jun 06/8/26(土) 9:09 発言[未読]
【41924】Re:データの集計方法について教えて下さい かみちゃん 06/8/26(土) 9:22 発言[未読]
【41926】Re:データの集計方法について教えて下さい jun 06/8/26(土) 9:45 発言[未読]
【41931】Re:データの集計方法について教えて下さい Ned 06/8/26(土) 10:56 発言[未読]
【41932】Re:データの集計方法について教えて下さい jun 06/8/26(土) 11:15 お礼[未読]
【41952】Re:データの集計方法について教えて下さい Ned 06/8/26(土) 22:32 発言[未読]
【41955】Re:データの集計方法について教えて下さい Ned 06/8/26(土) 23:24 発言[未読]
【41969】Re:データの集計方法について教えて下さい ichinose 06/8/27(日) 11:53 発言[未読]
【41970】Re:データの集計方法について教えて下さい jun 06/8/27(日) 12:01 お礼[未読]

【41860】データの集計方法について教えて下さい
質問  K.K  - 06/8/24(木) 15:42 -

引用なし
パスワード
   こんにちは。

下記のようなデータの集計方法に頭を悩ませています。

VBAで自動集計させたいのですが可能でしょうか?

<シート1>のセルA3からD3以降のデータを・・・

1   A   B     C     D

2  ロット  品名  不良内容  不良本数

3  0001  A   xx      1

4  0001  A   xy      3

5  0002  A   yz      1

6  0003  B   yy      1

7  0003  B   xx      2

8  0003  B   yz      2

9  0004  C   zz      1

       ↓

<シート2>のセルA3からH3以降に自動集計させたい

1   A    B   C   D   E   F   G   H

2  ロット  品名  xx  xy  yy  yz  zz  不良合計

3  0001  A   1   3                 4

4  0002  A               1         1

5  0003  B   2       1   2         5

6  0004  C                   1     1

分かる方おられましたら教えて下さい。

【41862】Re:データの集計方法について教えて下さい
発言  かみちゃん  - 06/8/24(木) 15:52 -

引用なし
パスワード
   こんにちは。 かみちゃん です。

> 下記のようなデータの集計方法に頭を悩ませています。
>
> VBAで自動集計させたいのですが可能でしょうか?

一般操作のピボットテーブルでできると思いますが、ご存知でしょうか?
それとも、Sheet2には、ロット、品名、不良内容は、あらかじめ入力されているのでしょうか?
さらに、同じロットで違う品名は存在するのでしょうか?

それによって、コードの組み方が変わってきます。

【41863】Re:データの集計方法について教えて下さい
発言  K.K  - 06/8/24(木) 16:19 -

引用なし
パスワード
   ▼かみちゃん さん:

早速ありがとうございます。
ご質問の件ですが、ここに投稿する前にピポットテーブルで試みたものの思うように
いきませんでした。
やはりやり方次第で可能なんですね。

Sheet2のA2からH2には、ロット、品名、不良内容、合計は、あらかじめ入力されています。

>こんにちは。 かみちゃん です。
>
>> 下記のようなデータの集計方法に頭を悩ませています。
>>
>> VBAで自動集計させたいのですが可能でしょうか?
>
>一般操作のピボットテーブルでできると思いますが、ご存知でしょうか?
>それとも、Sheet2には、ロット、品名、不良内容は、あらかじめ入力されているのでしょうか?
>さらに、同じロットで違う品名は存在するのでしょうか?
>
>それによって、コードの組み方が変わってきます。

【41864】Re:データの集計方法について教えて下さい
発言  K.K  - 06/8/24(木) 16:30 -

引用なし
パスワード
   ▼かみちゃん さん:

続けて申し訳ありません。
ご質問に対して間違った受け止め方をしていたようです。
sheet2にはA2からH2にロット、品名、不良内容、合計が表示されているのみです。
集計を行うとA3からH3以降に集計結果が表示されるようにしたいです。

なお、同じロット内には違う品名は存在しません。

言葉が足らず失礼しました。


>こんにちは。 かみちゃん です。
>
>> 下記のようなデータの集計方法に頭を悩ませています。
>>
>> VBAで自動集計させたいのですが可能でしょうか?
>
>一般操作のピボットテーブルでできると思いますが、ご存知でしょうか?
>それとも、Sheet2には、ロット、品名、不良内容は、あらかじめ入力されているのでしょうか?
>さらに、同じロットで違う品名は存在するのでしょうか?
>
>それによって、コードの組み方が変わってきます。

【41865】Re:データの集計方法について教えて下さい
回答  かみちゃん E-MAIL  - 06/8/24(木) 16:34 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> sheet2にはA2からH2にロット、品名、不良内容、合計が表示されているのみです。
> 集計を行うとA3からH3以降に集計結果が表示されるようにしたいです。
> なお、同じロット内には違う品名は存在しません。

エラー処理は、していませんので、データによってはエラーが出るかもしれませんが、

Sub Macro1()
 Dim lngRow As Long
 Dim intCol As Integer
 Dim vntData As Variant
 Dim c As Range
 Dim LastCell As Range
 
 With Sheets("Sheet2")
  ReDim vntData(1 To .Range("A65536").End(xlUp).Row - 1, _
   1 To .Range("IV1").End(xlToLeft).Column - 2)
 End With

 Set LastCell = Range("A65536").End(xlUp).Value
 For Each c In Range("A2", LastCell)
  '「ロット」の位置を検索
  lngRow = Application.Match(c.Value, Sheets("Sheet2").Columns(1))
  '「不良内容」の位置を検索
  intCol = Application.Match(c.Offset(, 2).Value, Sheets("Sheet2").Rows(1))
  '内訳欄の計算
  vntData(lngRow - 1, intCol - 2) = _
   vntData(lngRow - 1, intCol - 2) + c.Offset(, 3).Value
  '合計欄の計算
  vntData(lngRow - 1, UBound(vntData, 2)) = _
   vntData(lngRow - 1, UBound(vntData, 2)) + c.Offset(, 3).Value
 Next
 '集計結果を書き込む
 Sheets("Sheet2").Range("C2").Resize(UBound(vntData, 1), UBound(vntData, 2)).Value = vntData
End Sub

【41866】Re:データの集計方法について教えて下さい
お礼  K.K  - 06/8/24(木) 17:07 -

引用なし
パスワード
   ▼かみちゃん さん:

ありがとうございます。
下記の部分でメモリ不足のエラーが出てしまいますが、メモリを増やして対応して
みます。
 
> With Sheets("Sheet2")
>  ReDim vntData(1 To .Range("A65536").End(xlUp).Row - 1, _
>   1 To .Range("IV1").End(xlToLeft).Column - 2)
> End With
>

【41868】Re:データの集計方法について教えて下さい
発言  かみちゃん E-MAIL  - 06/8/24(木) 17:42 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 下記の部分でメモリ不足のエラーが出てしまいますが、メモリを増やして対応して
> みます。

メモリ増設などの問題ではないと思われます。
こちらでは提示されたサンプルデータでの動作確認はしてあります。
他に起動しているアプリケーションがない(常駐などはありますが)状態で動作確認していますので、お使いのパソコンを再起動して試してみたりしてください。

その上で、提示されたサンプルデータでエラーが出るなら、おたずねいただきたいですし、
他のデータであれば、エラーの出るデータの内容を教えていただきたいと思います。

【41869】Re:データの集計方法について教えて下さい
発言  kazuo  - 06/8/24(木) 18:18 -

引用なし
パスワード
   かみちゃんkazuoです
横から失礼!
昨日はありがとうございました。
このコード私も動作させてみたのですがメモリ不足と
出てしまいました。???
なぜなんでしょうかね・・・
参考までに(^^)

【41871】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/24(木) 18:58 -

引用なし
パスワード
   ▼K.K さん:
こんにちは。レイアウトの違いかしら。
Sheet1,Sheet2ともA1起点かA2起点か。
また、
Set LastCell = Range("A65536").End(xlUp)
lngRow = Application.Match(c.Value, Sheets("Sheet2").Columns(1), 0)
intCol = Application.Match(c.Offset(, 2).Value, Sheets("Sheet2").Rows(1), 0)
コードを書いてもらうだけじゃなく、内容を理解して修正しないといけないですよ。
難しいようならピボットテーブルをおすすめしますけどネ^ ^

【41873】Re:データの集計方法について教えて下さい
回答  かみちゃん E-MAIL  - 06/8/24(木) 19:53 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>このコード私も動作させてみたのですがメモリ不足と
>出てしまいました。???

kazuoさん、申告ありがとうございます。
こちらで再度検証しましたところ、[#41865]で提示したコードにあきらかな間違い(エラーが出るはずです)と、
[#41871]のNedさんアドバイスによる改善点がありますので、再度コードを提示させていただきます。

Sub Macro2()
 Dim lngRow As Long
 Dim intCol As Integer
 Dim vntData As Variant
 Dim c As Range
 Dim LastCell As Range

 With Sheets("Sheet2")
  ReDim vntData(1 To .Range("A65536").End(xlUp).Row - 1, _
   1 To .Range("IV1").End(xlToLeft).Column - 2)
 End With

 Set LastCell = Range("A65536").End(xlUp) '★
 For Each c In Range("A2", LastCell)
  '「ロット」の位置を検索
  lngRow = Application.Match(c.Value, Sheets("Sheet2").Columns(1), 0) '★
  '「不良内容」の位置を検索
  intCol = Application.Match(c.Offset(, 2).Value, Sheets("Sheet2").Rows(1), 0) '★
  '内訳欄の計算
  vntData(lngRow - 1, intCol - 2) = _
   vntData(lngRow - 1, intCol - 2) + c.Offset(, 3).Value
  '合計欄の計算
  vntData(lngRow - 1, UBound(vntData, 2)) = _
   vntData(lngRow - 1, UBound(vntData, 2)) + c.Offset(, 3).Value
 Next
 '集計結果を書き込む
 Sheets("Sheet2").Range("C2").Resize(UBound(vntData, 1), UBound(vntData, 2)).Value = vntData
End Sub

なお、[#41860]の提示イメージのSheet2の「不良合計」より右側および最終のロットより下側に
値がないことが大前提です。
1行目およびA列の値が入っている最後の位置を探して、集計表の大きさを決めています。
あまりにも大きい表だと「メモリ不足」は起こるようですが、少なくとも提示いただいたイメージ
だけですと、動作することを確認しています。
必要であれば、確認したブック差し上げますので、ご連絡ください。

これでも駄目でしたら、配列を使わない方法を提案したいと思います。

【41874】Re:データの集計方法について教えて下さい
発言  かみちゃん E-MAIL  - 06/8/24(木) 19:57 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>このコード私も動作させてみたのですがメモリ不足と
>>出てしまいました。???

あ〜、よく見たら、

> <シート1>のセルA3からD3以降のデータを・・・
>
> 1   A   B     C     D
> 2  ロット  品名  不良内容  不良本数
> 3  0001  A   xx      1

というシートレイアウトなのですね。
ごめんなさい。1行目にA、B、C・・・と入力してあるのですか?
1行目は、ロット、品名、不良内容・・・と入力してあるものとしてコードを提案
させていただいています。
勝手な解釈をしてしまいました。

コードを修正するのは、簡単ですが、シートレイアウトが本当に2行目にロット、
品名、不良内容・・・で、コードの修正方法がわからなければ、再度聞いてくだ
さい。

【41875】Re:データの集計方法について教えて下さい
発言  かみちゃん  - 06/8/24(木) 19:59 -

引用なし
パスワード
   Ned さん、こんにちは。かみちゃん です。

>こんにちは。レイアウトの違いかしら。
>Sheet1,Sheet2ともA1起点かA2起点か。
>また、
>Set LastCell = Range("A65536").End(xlUp)
>lngRow = Application.Match(c.Value, Sheets("Sheet2").Columns(1), 0)
>intCol = Application.Match(c.Offset(, 2).Value, Sheets("Sheet2").Rows(1), 0)

ご指摘ありがとうございます。
レイアウトの違い、Valueプロパティの間違い、Match関数の照合の型・・・
慌てて書くとロクなことないですね。

【41876】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/24(木) 20:32 -

引用なし
パスワード
   ▼かみちゃん さん:
こんにちは。
>慌てて書くとロクなことないですね。
私もよくあります^ ^;
ただ基本的には、質問者さんにも『内容を理解して』工夫してもらいたいとは思っています。

でも今回は
><シート1>のセルA3からD3以降のデータを・・・
><シート2>のセルA3からH3以降に自動集計させたい
と明記してありますから、1行目が空欄だと『実行時エラー'7'』と出ますね。
それに
>sheet2にはA2からH2にロット、品名、不良内容、合計が表示されているのみです。
>集計を行うとA3から...
なので『ロット』,『品名』の抽出から行わなければならないのではないかと推測しています。

【41889】Re:データの集計方法について教えて下さい
発言  kobasan  - 06/8/24(木) 23:11 -

引用なし
パスワード
   みなさん 今晩は。

この類は、Dictionaryを利用するのが楽でいいと思います。

過去ログの【28364】を参考にすると出来ます。

【41892】Re:データの集計方法について教えて下さい
お礼  k.k  - 06/8/25(金) 10:54 -

引用なし
パスワード
   みなさんご親切に教えて下さりありがとうございます。
教えて下さったコードを参考に自分で工夫していきます。
またわからないことがあればよろしくお願いします。

【41912】Re:データの集計方法について教えて下さい
質問  jun  - 06/8/26(土) 2:25 -

引用なし
パスワード
   みなさんこんばんわ VBAを初めて数日の超素人です
クロス集計に興味を持ちkobasanさんご紹介の下記で
勉強と思い見よう見まねでコードを修正しいろいろテスト
してみたのですがうまくいきませんでした。
どなたかご教授お願いします。
>この類は、Dictionaryを利用するのが楽でいいと思います。
>過去ログの【28364】を参考にすると出来ます。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=28366;id=excel
こんなふうに↓修正し動作させたところ

[#41860]の表に対し修正

Sub test()
  Dim rs As Object
  Dim mysql As String
  
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "Transform iif(isnull(Count(不良本数)),0,Count(不良内容)) " & _
        "Select ロット,品名 From [Sheet1$] Group By ロット,品名 " & _
        "Pivot 不良内容;"
    If get_exec_sql(mysql, rs) = 0 Then

     With Worksheets("Sheet2")
      .Cells.ClearContents
      .Range("a2").CopyFromRecordset rs
      For idx = 0 To rs.fields.Count - 1
       .Cells(1, idx + 1).Value = rs.fields(idx).Name
       Next
      
      End With
     Call rs_close(rs)
    Else
     MsgBox "rs error"
     End If
     
    Call close_ado
  Else
    MsgBox "cn error"
    End If
   
End Sub
下記のような変なデータしか出ませんでした。
  A   B    C    D    E    F    G    H
ロット    品名    <>    XX    XY    YY    YZ    ZZ
        0    0    0    0    0    0
0001    A    0    1    1    0    0    0
0002    A    0    0    0    0    1    0
0003    B    0    1    0    1    1    0
0004    C    0    0    0    0    0    1
どこをどう修正したらいいのか解らなくなりました。
上記データで2行目とC列は不要だと思います。
それと不良合計をどう出したらいいかわかりません。
また上記一行目はKKさんの質問ではあらかじめ入力済みとありますがどうせなら
VBAで一気に書き込んだ方がいいと思うのですが。

次に、とまとさんのコードですが得る答えは一緒だと思いますが
このコードはほとんどどこをなおしていいやら上記より難解です。
お分かりになる方お願いします。
Sub 集計()


Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim dicA As Object
Dim dicB As Object
Dim dicC As Object
Dim vntA, vntB
Dim i As Long, j As Long

Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")


Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
Set dicC = CreateObject("Scripting.Dictionary")


vntA = sh1.Range("A2", sh1.Range("B65536").End(xlUp)).Value
For i = 1 To UBound(vntA)
 dicA(vntA(i, 1) & vntA(i, 2)) = dicA(vntA(i, 1) & vntA(i, 2)) + 1
 dicB(vntA(i, 1)) = Empty
 dicC(vntA(i, 2)) = Empty
Next i

sh2.Range("A2").Resize(dicB.Count).Value = Application.Transpose(dicB.keys())
sh2.Range("B1").Resize(, dicC.Count).Value = dicC.keys()

vntB = sh2.Range("A1").CurrentRegion.Value
For i = 2 To UBound(vntB)
  For j = 2 To dicC.Count + 1
  vntB(i, j) = dicA(vntB(i, 1) & vntB(1, j))
  Next
Next i
sh2.Range("A1").CurrentRegion.Value = vntB


Set sh1 = Nothing
Set sh2 = Nothing
Set dicA = Nothing
Set dicB = Nothing
Set dicC = Nothing

追伸;おおよその解説を付けていただけると今後の勉強に役立ちますので
   助かるのですが・・・
乱文ですがよろしくお願いします。
ちなみに、かみちゃんさんのコードではどなたかのresにあるように
わたしのPCもメモリ不足とでてしまいました。winxp/excel2002です。

【41913】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/26(土) 2:32 -

引用なし
パスワード
   ▼jun さん:
こんにちは。
>クロス集計に興味を持ち
...なら、まずはピボットテーブルだと思います。
リンクスレッドは、題名に『ピボットテーブルを使わずにクロス集計』とあるように、
あえてピボットテーブルを使わない場合のコードです。
VBAの手法としていろいろな方法を勉強されるのは良いことだと思いますが、
>VBAを初めて数日
ならまずはVBAのA。Application自体に備えられている基本機能を
押さえておかれる事をおすすめします。

#もし、ピボットについては卒業。という事であれば余計な事でした。ごめんなさい。
#それにこのスレッドは解決しているようですから、
#リンク張った上で新規質問にされたほうがいいのではないかしらん?^ ^

【41914】Re:データの集計方法について教えて下さい
発言  jun  - 06/8/26(土) 2:41 -

引用なし
パスワード
   ▼Ned さん:
返事ありがとうございます
>こんにちは。
>>クロス集計に興味を持ち
>...なら、まずはピボットテーブルだと思います。
>リンクスレッドは、題名に『ピボットテーブルを使わずにクロス集計』とあるように、
上記ピポットテーブルで同じ答え(正解に)たどり着けました。その上で
今回質問させていただきました。
ちなみにマクロの記録でも同様の答えを出すことが出来ました。
マクロの記録だと範囲は限定されたり色々制限ありますので、
このコードで少し学習しようと思ったのであります。
>あえてピボットテーブルを使わない場合のコードです。
>VBAの手法としていろいろな方法を勉強されるのは良いことだと思いますが、
>>VBAを初めて数日
>ならまずはVBAのA。Application自体に備えられている基本機能を
>押さえておかれる事をおすすめします。
>
>#もし、ピボットについては卒業。という事であれば余計な事でした。ごめんなさい。
>#それにこのスレッドは解決しているようですから、
>#リンク張った上で新規質問にされたほうがいいのではないかしらん?^ ^
質問の流れが同じなので新規ではなく追加発言させていただきました。
新規のほうががよいのでしょうか???
この場でres待ちます。よろしくお願いします。

【41915】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/26(土) 4:06 -

引用なし
パスワード
   ▼jun さん:
>マクロの記録だと範囲は限定されたり色々制限ありますので、
...んん...これを解析するよりピボットベース+ひと工夫。の方がラクな気はしますけど
Sub sample()
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim dicA As Object
  Dim dicB As Object
  Dim dicC As Object
  Dim i As Long
  Dim j As Long
  Dim n As Long
  Dim vntA, vntB, x
  
  Set sh1 = Worksheets("Sheet1")
  Set sh2 = Worksheets("Sheet2")
  Set dicA = CreateObject("Scripting.Dictionary")
  Set dicB = CreateObject("Scripting.Dictionary")
  Set dicC = CreateObject("Scripting.Dictionary")
  sh2.UsedRange.Clear
  vntA = sh1.Range("A2").CurrentRegion.Value
  For i = 1 To UBound(vntA)
    x = vntA(i, 1) & "," & vntA(i, 2) & vntA(i, 3)
    dicA(x) = dicA(x) + vntA(i, 4)
    dicB(vntA(i, 1) & "," & vntA(i, 2)) = Empty
    dicC(vntA(i, 3)) = Empty
  Next i
  With sh2.Range("A1").Resize(dicB.Count)
    .Value = Application.Transpose(dicB.keys())
    .TextToColumns _
      Destination:=Range("A1"), _
       DataType:=xlDelimited, _
       Comma:=True, _
        FieldInfo:=Array(Array(1, 2), Array(2, 2))
  End With
  With sh2.Range("B1")
    .Resize(, dicC.Count).Value = dicC.keys()
    .Value = sh1.Range("B2").Value
  End With
  With sh2.Range("A1").CurrentRegion
    vntB = .Resize(, .Columns.Count + 1).Value
    n = UBound(vntB, 2)
    vntB(1, n) = "不良数計"
    For i = 2 To UBound(vntB)
      For j = 3 To dicC.Count + 1
      vntB(i, j) = dicA(vntB(i, 1) & "," & vntB(i, 2) & vntB(1, j))
      vntB(i, n) = vntB(i, n) + vntB(i, j)
      Next
    Next i
    .Resize(, .Columns.Count + 1).Value = vntB
  End With
  
  Set sh1 = Nothing
  Set sh2 = Nothing
  Set dicA = Nothing
  Set dicB = Nothing
  Set dicC = Nothing
End Sub
ちょっと手抜きしてます。&眠いので今日はここまでネm(_ _)m

【41923】Re:データの集計方法について教えて下さい
発言  jun  - 06/8/26(土) 9:09 -

引用なし
パスワード
   ▼Ned さん:
おぉー
おはようございます。無理言ってすみません。

>>マクロの記録だと範囲は限定されたり色々制限ありますので、
>...んん...これを解析するよりピボットベース+ひと工夫。の方がラクな気はしま>>すけど
確かにピポットテーブルでもやってみましたがほんの数秒でした。
はぁ・・??ただそのひと工夫ががが難しのですよ素人には・・・。

>ちょっと手抜きしてます。&眠いので今日はここまでネm(_ _)m
ごめんさい。_(_^_)_
Nedに作っていただいたものとまえのものよく比較し、
役に立てたいと思います・・・・・
寝込みを襲うようで申し訳ないですが↓のほうもよろしくお願いします。
Sub test()
  Dim rs As Object
  Dim mysql As String
  
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "Transform iif(isnull(Count(不良本数)),0,Count(不良内容)) " & _
        "Select ロット,品名 From [Sheet1$] Group By ロット,品名 " & _
        "Pivot 不良内容;"
    If get_exec_sql(mysql, rs) = 0 Then

     With Worksheets("Sheet2")
      .Cells.ClearContents
      .Range("a2").CopyFromRecordset rs
      For idx = 0 To rs.fields.Count - 1
       .Cells(1, idx + 1).Value = rs.fields(idx).Name
       Next
      
      End With
     Call rs_close(rs)
    Else
     MsgBox "rs error"
     End If
     
    Call close_ado
  Else
    MsgBox "cn error"
    End If
   
End Sub
(-_-;)(-_-;)(-_-;)

【41924】Re:データの集計方法について教えて下さい
発言  かみちゃん  - 06/8/26(土) 9:22 -

引用なし
パスワード
   こんにちは。かみちゃん です。

横から失礼します。

>>>マクロの記録だと範囲は限定されたり色々制限ありますので、
>>...んん...これを解析するよりピボットベース+ひと工夫。の方がラクな気はしま>>すけど
>確かにピポットテーブルでもやってみましたがほんの数秒でした。
>はぁ・・??ただそのひと工夫ががが難しのですよ素人には・・・。

「範囲は限定」とありますが、それは、「マクロの記録」で記録したコードのことでしょうか?
それであれば、その「範囲」を実行の都度、取得して設定すればいいことになります。
そちらのほうが楽ですよ。
なぜなら、手動でしていることがコードになっているだけですから、仕組みはわかりますよね?
ただ、コードの提示がないから、具体的に修正箇所が説明できません。

他にピボットテーブルの制限事項とは何でしょうか?

今回の元々の質問は、行タイトル、列タイトルがあらかじめ固定されているという
のが要件でした。
つまり、
ピボットテーブルや
Scripting.Dictionary
では、行タイトル、列タイトルにない要素があれば、期待どおりの結果にならない
と思います。

そういう意味で、junさんのご質問は、行タイトルと列タイトルが固定なのかそうでないのか、
Scripting.Dictionary
でしたいのか、クロス集計でしたいのかがよくわかりません。
いずれにしても、そのようなことがしたいのならば、ピボットテーブルが簡単と
私も思います。

>Nedに作っていただいたものとまえのものよく比較し、
>役に立てたいと思います・・・・・
>寝込みを襲うようで申し訳ないですが↓のほうもよろしくお願いします。

これは、動かないから検証してほしいということなのでしょうか?

【41926】Re:データの集計方法について教えて下さい
発言  jun  - 06/8/26(土) 9:45 -

引用なし
パスワード
   ▼かみちゃん さん:
おはようございますresありがとうございます
>
>横から失礼します。
>
>>>>マクロの記録だと範囲は限定されたり色々制限ありますので、
>>>...んん...これを解析するよりピボットベース+ひと工夫。の方がラクな気はしま>>すけど
>>確かにピポットテーブルでもやってみましたがほんの数秒でした。
>>はぁ・・??ただそのひと工夫ががが難しのですよ素人には・・・。
>
>「範囲は限定」とありますが、それは、「マクロの記録」で記録したコードのことでしょうか?
>それであれば、その「範囲」を実行の都度、取得して設定すればいいことになります。
>そちらのほうが楽ですよ。
>なぜなら、手動でしていることがコードになっているだけですから、仕組みはわかりますよね?
>ただ、コードの提示がないから、具体的に修正箇所が説明できません。
>他にピボットテーブルの制限事項とは何でしょうか?

はいあまり深くは考えていませんが、別のケースを想定したり、
まぁ空想の話です。今後その場面があるかどうかはわかりません。

>今回の元々の質問は、行タイトル、列タイトルがあらかじめ固定されているという
>のが要件でした。
>つまり、
>ピボットテーブルや
>Scripting.Dictionary
>では、行タイトル、列タイトルにない要素があれば、期待どおりの結果にならない
>と思います。
いろいろ答えは同じでもやり方がいろいろ考え方もいろいろでしょから
>そういう意味で、junさんのご質問は、行タイトルと列タイトルが固定なのかそうでないのか、
>Scripting.Dictionary
>でしたいのか、クロス集計でしたいのかがよくわかりません。
>いずれにしても、そのようなことがしたいのならば、ピボットテーブルが簡単と
>私も思います。
>
>>Nedに作っていただいたものとまえのものよく比較し、
>>役に立てたいと思います・・・・・
>>寝込みを襲うようで申し訳ないですが↓のほうもよろしくお願いします。
kobasanが紹介している [#28364] に2通りのやり方があり
それを参考に見よう見まねですが下のように改良してみたのですが
思うように結果が出なかったものですからNedさんに無理言って
見て貰いどこを直せばいいのか質問してました。(できれば解説付き)
[#41951]はその2つめです。
その1
Sub test()
  Dim rs As Object
  Dim mysql As String
  
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "Transform iif(isnull(Count(不良本数)),0,Count(不良内容)) " & _
        "Select ロット,品名 From [Sheet1$] Group By ロット,品名 " & _
        "Pivot 不良内容;"
    If get_exec_sql(mysql, rs) = 0 Then

     With Worksheets("Sheet2")
      .Cells.ClearContents
      .Range("a2").CopyFromRecordset rs
      For idx = 0 To rs.fields.Count - 1
       .Cells(1, idx + 1).Value = rs.fields(idx).Name
       Next
      
      End With
     Call rs_close(rs)
    Else
     MsgBox "rs error"
     End If
     
    Call close_ado
  Else
    MsgBox "cn error"
    End If
   
End Sub
>これは、動かないから検証してほしいということなのでしょうか?
いえ動いています。
ロット    品名    不良内容    不良本数
0001    A    XX    1
0001    A    XY    3
0002    A    YZ    1
0003    B    YY    1
0003    B    XX    2
0003    B    YZ    2
0004    C    ZZ    1
0005    C    YZ    5
手動記録のピポットです。
Sub ぴぽっと()
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    "Sheet1!A1:D20").CreatePivotTable TableDestination:="", TableName:= _
    "ピボットテーブル2", DefaultVersion:=xlPivotTableVersion10
  ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
  ActiveSheet.Cells(3, 1).Select
  With ActiveSheet.PivotTables("ピボットテーブル2").PivotFields("ロット")
    .Orientation = xlRowField
    .Position = 1
  End With
  With ActiveSheet.PivotTables("ピボットテーブル2").PivotFields("品名")
    .Orientation = xlRowField
    .Position = 2
  End With
  With ActiveSheet.PivotTables("ピボットテーブル2").PivotFields("不良内容")
    .Orientation = xlColumnField
    .Position = 1
  End With
  ActiveSheet.PivotTables("ピボットテーブル2").AddDataField ActiveSheet.PivotTables( _
    "ピボットテーブル2").PivotFields("不良本数"), "合計 / 不良本数", xlSum
  Range("A6").Select
  Selection.Delete
  Range("C4:G9").Select
  With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
  End With
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  Range("A10").Select
  Selection.Delete
  Range("C5").Select
End Sub

【41931】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/26(土) 10:56 -

引用なし
パスワード
   ▼jun さん:
>はぁ・・??
という表現はレス気なくす人もいますから気をつけたほうがいいですよ。
あとヨビステもね。や、冗談やけど^ ^

ほんとはScripting.Dictionaryの前に、配列について理解したほうが良いです。
Sub vntsample()
'yのmatchキーは手抜きでA列のみ
  Dim sh As Worksheet
  Dim i As Long
  Dim n As Long
  Dim v, w, x, y
  Set sh = Sheets("sheet2")
  sh.UsedRange.Clear
  With Sheets("sheet1").Range("A2").CurrentRegion
    .Resize(, 2).AdvancedFilter _
      Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
    .Columns(3).AdvancedFilter _
      Action:=xlFilterInPlace, Unique:=True
    .Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
      sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    .Worksheet.ShowAllData
    v = .Resize(.Rows.Count - 1).Offset(1).Value
  End With
  With sh.Range("A1").CurrentRegion
    n = .Columns.Count + 1
    w = .Resize(, n).Value
    w(1, n) = "不良合計"
    For i = 1 To UBound(v)
      With Application
        y = .Match(v(i, 1), .Index(w, 0, 1), 0)
        x = .Match(v(i, 3), .Index(w, 1, 0), 0)
      End With
      If Not IsError(y) And Not IsError(x) Then
        w(y, x) = w(y, x) + v(i, 4)
        w(y, n) = w(y, n) + v(i, 4)
      End If
    Next i
    .Resize(, n).Value = w
  End With
  Set sh = Nothing
End Sub

↓これはピボットサンプル。
Sub pvtsample()
  Dim r As Range
  Application.ScreenUpdating = False
  Set r = Sheets("sheet1").Range("A2").CurrentRegion
  With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
       SourceData:=r.Address(external:=True)). _
       CreatePivotTable(TableDestination:="")
    .Format xlPTNone
    .AddFields RowFields:=Array(r.Cells(1).Value, r.Cells(2).Value), _
       ColumnFields:=r.Cells(3).Value
    With .PivotFields(r.Cells(4).Value)
      .Orientation = xlDataField
      .Function = xlSum
    End With
    .PivotFields(r.Cells(1).Value).Subtotals(1) = False
    With .TableRange1
      .Copy
      .PasteSpecial Paste:=xlPasteValues
      .Interior.ColorIndex = xlNone
      .Rows(1).Delete
      .BorderAround Weight:=xlThin
      .Borders(xlInsideVertical).Weight = xlThin
      .Borders(xlInsideHorizontal).Weight = xlThin
    End With
  End With
  Set r = Nothing
  Application.ScreenUpdating = True
End Sub

↓これは蛇足。
Sub fncsample()
  Dim sh As Worksheet
  Dim s As String
  Set sh = Sheets("sheet2")
  sh.UsedRange.Clear
  With Sheets("sheet1").Range("A2").CurrentRegion
    .Resize(, 2).AdvancedFilter _
      Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
    .Columns(3).AdvancedFilter _
      Action:=xlFilterInPlace, Unique:=True
    .Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
      sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    .Worksheet.ShowAllData
    With .Resize(.Rows.Count - 1).Offset(1)
      s = "=SUMPRODUCT((Sheet1!" & .Columns(1).Address & "&Sheet1!" _
        & .Columns(3).Address & "=" & "$A2&C$1)*Sheet1!" & .Columns(4).Address & ")"
    End With
    With sh.Range("A1").CurrentRegion
      With .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2)
        .Formula = s
        .Value = .Value
        s = .Rows(1).Address(0, 1)
        With .Resize(, 1).Offset(, .Columns.Count)
          .Formula = "=SUM(" & s & ")"
          .Value = .Value
          .Offset(-1).Resize(1).Value = "不良合計"
        End With
      End With
    End With
  End With
  Set sh = Nothing
End Sub

[#41860]のシートレイアウトでテスト。ただしSheet2はA1起点。
解説は苦手なのでまずは[ローカルウィンドウ]+[ステップ実行]が理解への近道かと。
#ADO+SQLはテストしてないのでレスできません。

【41932】Re:データの集計方法について教えて下さい
お礼  jun  - 06/8/26(土) 11:15 -

引用なし
パスワード
   ▼Ned さん:
>▼jun さん:
>>はぁ・・??
>という表現はレス気なくす人もいますから気をつけたほうがいいですよ。
はい気をつけます。
>あとヨビステもね。や、冗談やけど^ ^
どっかしてましたか?失礼しました。
>
>ほんとはScripting.Dictionaryの前に、配列について理解したほうが良いです。
はいそう思いますがむずかしぃー(=_=)
>Sub vntsample()
>'yのmatchキーは手抜きでA列のみ
>  Dim sh As Worksheet
>  Dim i As Long
>  Dim n As Long
>  Dim v, w, x, y
>  Set sh = Sheets("sheet2")
>  sh.UsedRange.Clear
>  With Sheets("sheet1").Range("A2").CurrentRegion
>    .Resize(, 2).AdvancedFilter _
>      Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
>    .Columns(3).AdvancedFilter _
>      Action:=xlFilterInPlace, Unique:=True
>    .Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
>      sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
>    Application.CutCopyMode = False
>    .Worksheet.ShowAllData
>    v = .Resize(.Rows.Count - 1).Offset(1).Value
>  End With
>  With sh.Range("A1").CurrentRegion
>    n = .Columns.Count + 1
>    w = .Resize(, n).Value
>    w(1, n) = "不良合計"
>    For i = 1 To UBound(v)
>      With Application
>        y = .Match(v(i, 1), .Index(w, 0, 1), 0)
>        x = .Match(v(i, 3), .Index(w, 1, 0), 0)
>      End With
>      If Not IsError(y) And Not IsError(x) Then
>        w(y, x) = w(y, x) + v(i, 4)
>        w(y, n) = w(y, n) + v(i, 4)
>      End If
>    Next i
>    .Resize(, n).Value = w
>  End With
>  Set sh = Nothing
>End Sub
>
>↓これはピボットサンプル。
>Sub pvtsample()
>  Dim r As Range
>  Application.ScreenUpdating = False
>  Set r = Sheets("sheet1").Range("A2").CurrentRegion
>  With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
>       SourceData:=r.Address(external:=True)). _
>       CreatePivotTable(TableDestination:="")
>    .Format xlPTNone
>    .AddFields RowFields:=Array(r.Cells(1).Value, r.Cells(2).Value), _
>       ColumnFields:=r.Cells(3).Value
>    With .PivotFields(r.Cells(4).Value)
>      .Orientation = xlDataField
>      .Function = xlSum
>    End With
>    .PivotFields(r.Cells(1).Value).Subtotals(1) = False
>    With .TableRange1
>      .Copy
>      .PasteSpecial Paste:=xlPasteValues
>      .Interior.ColorIndex = xlNone
>      .Rows(1).Delete
>      .BorderAround Weight:=xlThin
>      .Borders(xlInsideVertical).Weight = xlThin
>      .Borders(xlInsideHorizontal).Weight = xlThin
>    End With
>  End With
>  Set r = Nothing
>  Application.ScreenUpdating = True
>End Sub
>
>↓これは蛇足。
>Sub fncsample()
>  Dim sh As Worksheet
>  Dim s As String
>  Set sh = Sheets("sheet2")
>  sh.UsedRange.Clear
>  With Sheets("sheet1").Range("A2").CurrentRegion
>    .Resize(, 2).AdvancedFilter _
>      Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
>    .Columns(3).AdvancedFilter _
>      Action:=xlFilterInPlace, Unique:=True
>    .Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
>      sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
>    Application.CutCopyMode = False
>    .Worksheet.ShowAllData
>    With .Resize(.Rows.Count - 1).Offset(1)
>      s = "=SUMPRODUCT((Sheet1!" & .Columns(1).Address & "&Sheet1!" _
>        & .Columns(3).Address & "=" & "$A2&C$1)*Sheet1!" & .Columns(4).Address & ")"
>    End With
>    With sh.Range("A1").CurrentRegion
>      With .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2)
>        .Formula = s
>        .Value = .Value
>        s = .Rows(1).Address(0, 1)
>        With .Resize(, 1).Offset(, .Columns.Count)
>          .Formula = "=SUM(" & s & ")"
>          .Value = .Value
>          .Offset(-1).Resize(1).Value = "不良合計"
>        End With
>      End With
>    End With
>  End With
>  Set sh = Nothing
>End Sub
>
>[#41860]のシートレイアウトでテスト。ただしSheet2はA1起点。
>解説は苦手なのでまずは[ローカルウィンドウ]+[ステップ実行]が理解への近道かと。
>#ADO+SQLはテストしてないのでレスできません。
Nedさんはこういうコードをわずかな時間で書けるのでしょうか。
うらやしい どんな勉強法ですか???
★いい勉強方法があれば教えて下さい。

とにかく思っていたことは全て解決しました。
ありがとうございました。_(._.)_(^o^)

【41952】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/26(土) 22:32 -

引用なし
パスワード
   ▼jun さん:
>Nedさんはこういうコードをわずかな時間で書けるのでしょうか。
>うらやしい どんな勉強法ですか???
>★いい勉強方法があれば教えて下さい。

一応お応えしておきますと、多分私はコードを書くのは遅いほうだと思います。
今回はクロス集計についてのストック分から引き出して修正しただけです。

勉強については
1)まず必要性ありきで、実務のために勉強する事。
2)自分で試行錯誤してみる事。
具体的には、
[マクロの記録][HELP][ローカルウィンドウ][ステップ実行][google][時間]
を使っています。
書籍は何冊か持ってますが、一番タメになったのは
渡辺ひかる氏『Excel VBA 実用サンプルコレクション』
ttp://www.amazon.co.jp/gp/product/4797320877/
こういった掲示板のサンプルコードにも言える事ですが、
実際にワンステップずつ動かしながら確認する事は、
理解も深まり、とても効果的だと思います。
では。がんばってください^ ^

【41955】Re:データの集計方法について教えて下さい
発言  Ned  - 06/8/26(土) 23:24 -

引用なし
パスワード
   ついでに、忘れ物^ ^
Sub adosample()
  Dim rs As Object
  Dim mysql As String
  Dim i As Long
  
  If open_ado_excel(ThisWorkbook.FullName) = 0 Then
    mysql = "Transform iif(isnull(sum(不良本数)),0,sum(不良本数)) " _
        & "Select [ロット],[品名],sum([不良本数]) " _
        & "From [Sheet1$] " _
         & "Group By [ロット],[品名] " _
         & "Pivot 不良内容;"
    If get_exec_sql(mysql, rs) = 0 Then
      With Sheets("Sheet2")
        .UsedRange.ClearContents
        .Range("A2").CopyFromRecordset rs
        For i = 0 To rs.fields.Count - 1
          .Cells(1, i + 1).Value = rs.fields(i).Name
        Next i
      End With
      Call rs_close(rs)
    Else
      MsgBox "rs error"
    End If
    Call close_ado
  Else
    MsgBox "cn error"
  End If
End Sub
これは、ありがとうございます。私も勉強させてもらいました。
ただ、自Bookに対して繰り返し処理を行う場合はメモリリークに気をつけなければならないようです。
照会元のデータ量が多い場合は特に。
『BUG: メモリ リークは、ActiveX Data Objects ( ADO )を使用すると...』
ttp://support.microsoft.com/kb/319998/ja

【41969】Re:データの集計方法について教えて下さい
発言  ichinose  - 06/8/27(日) 11:53 -

引用なし
パスワード
   皆さん、こんにちは。

このスレッドは、見ていなかったのですが、
さっきみたら、以前の私が投稿したコードが引用されていたので
ちょっとだけ参加します。


>ただ、自Bookに対して繰り返し処理を行う場合はメモリリークに気をつけなければならないようです。
>照会元のデータ量が多い場合は特に。
>『BUG: メモリ リークは、ActiveX Data Objects ( ADO )を使用すると...』
>ttp://support.microsoft.com/kb/319998/ja


これは、私も以前このサイトで検証したことがありました。


発端は、

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=28269;id=excel

↑このスレッドでした。

[#28447]  実験1
[#28448]  実験2
[#28451]
[#28452]

ExcelブックをADOで接続するときは、Excelで開いているブックに対しては
問題がありそうです。

【41970】Re:データの集計方法について教えて下さい
お礼  jun  - 06/8/27(日) 12:01 -

引用なし
パスワード
   ▼Ned さん:

VBAに関するアドバイスありがとうございました。
早速書籍を取り寄せ頑張ってみたいと思います。
いろいろなコード作成いただき重ね重ね御礼です。
まだまだかじり始めたばかりですので、今後とも
よろしくお願いします。!(^^)!

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