エクセルＶＢＡの質問です

質問

sample.xlsがあり内容は下記のように
Ａ列に名前、Ｂ列に数字が入り、行数は一定でありません

田中一郎 3
鈴木健一 5
佐藤太郎 8
田中一郎 5
田中一郎 2
佐藤太郎 7
鈴木健一 3
佐藤太郎 9
鈴木健一 54
佐藤太郎 8
田中一郎 9

このエクセルシートにコマンドボタンを付け、ＶＢＡでコマンドボタンを押した場合
指定したエクセルファイル”kekka.xls”に

田中一郎 19
鈴木健一 62
佐藤太郎 32

と言うように、名前別でその氏名の横の数字の合計を表示させたいと考えています。
何卒お知恵をお貸しください、お願いします。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

本来、記録マクロでも十分にできるはすです。

ピボットでも良いとは思います。作られただけでは、テーブルというオブジェクトスタイルになっていますが、コピーするとRange 型の範囲になりますので、それは、普通のデータとしてまとまっています。

こちらは、もう少し古いテクニックで、フィルタオプションで名前を取り出して、SUMIFで集計するものです。ただし、基本的なことですが、ピボットでも、フィルタオブションでも、タイトル行が必要です。
Application.ScreenUpdating = False は、必要ありません。

ここでは、A1 に、「名前」B1 に「売上（仮）」でも入れてください。そうしないと集計が正しく取れません。他にも、「統合(Conslidate)」を使う方法もありますが、コード自体が仰々しくなるのでやめました。

以下は、雑な書き方ですが、一応、格好はつくと思います。

'-------------------------------------------
Sub TestMacro1()
　　Dim r1 As Range
　　Dim r2 As Range
　　Dim r3 As Range
　　Dim Bk As Workbook
　　With ActiveSheet
　　　　With .Range("A1").CurrentRegion.Columns(1)
　　　　　　.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　CopyToRange:=Range("D1"), Unique:=True
　　　　　　Set r1 = .Offset(1).Resize(.Rows.Count - 1)
　　　　　　Set r2 = .Offset(1, 1).Resize(.Rows.Count - 1)
　　　　End With
　　　　With .Range("D1").CurrentRegion
　　　　　　.Columns(1).Offset(1, 1).Resize(.Rows.Count - 1).Formula _
　　　　　　= "= SUMIF(" & r1.Address & ",D2," & r2.Address & ")"
　　　　End With
　　　　.Range("B1").Copy .Range("E1")
　　　　Set r3 = .Range("D1").CurrentRegion
　　　　r3.Value = r3.Value
　　End With
　　On Error Resume Next
　　Set Bk = Workbooks.Open("kekka.xls")　'開いているかチェック
　　If Err.Number > 0 Then
　　　 Set Bk = Workbooks.Open("kekka.xls")
　　End If
　　　　With Bk
　　　　　　r3.Copy .ActiveSheet.Range("A1")　'要工夫
　　　　' .Save　'保存
　　　　' .Close　'終了
　　　　End With
　　　　Set Bk = Nothing
End Sub

お礼

Wendy02さん　有難う御座います、思い通りの事が出来ました、感謝いたします。

回答No.2

watabe007

Private Sub CommandButton1_Click()
　　Dim myDic As Object
　　Dim c As Range

　　Set myDic = CreateObject("Scripting.Dictionary")
　　For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
　　　　myDic(c.Value) = myDic(c.Value) + c.Offset(, 1).Value
　　Next
　　Range("D1").Resize(myDic.Count, 2).Value = _
　　　　Application.Transpose(Array(myDic.Keys, myDic.Items))
End Sub

>指定したエクセルファイル”kekka.xls”に
D1セルに出力していますので応用してください。

お礼

watabe007さん
有難う御座います、シンプルなコードで大変好感が持てます、
kekka.xlsへの書き込みに部分のアドバイスを頂けたら大変助かるのですが、
もう一声お願い致します。

回答No.1

tom11

vbaでは、ないと、絶対駄目ですか？？？？
ピポットテーブルで、簡単に出来るのですが、

図の様に、

データが変わっても、sample.xlsを保存して、
kekka.xlsを更新するだけなのですが。

お礼

tom11さん
有難う御座います、今回はＶＢＡで何とかならないかと思ってますが
今後の参考にさせて頂きます。