• ベストアンサー

エクセルVBAの質問です

sample.xlsがあり内容は下記のように A列に名前、B列に数字が入り、行数は一定でありません 田中一郎 3 鈴木健一 5 佐藤太郎 8 田中一郎 5 田中一郎 2 佐藤太郎 7 鈴木健一 3 佐藤太郎 9 鈴木健一 54 佐藤太郎 8 田中一郎 9 このエクセルシートにコマンドボタンを付け、VBAでコマンドボタンを押した場合 指定したエクセルファイル”kekka.xls”に 田中一郎 19 鈴木健一 62 佐藤太郎 32 と言うように、名前別でその氏名の横の数字の合計を表示させたいと考えています。 何卒お知恵をお貸しください、お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんにちは。 本来、記録マクロでも十分にできるはすです。 ピボットでも良いとは思います。作られただけでは、テーブルというオブジェクトスタイルになっていますが、コピーすると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   

matupo69
質問者

お礼

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

その他の回答 (2)

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

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セルに出力していますので応用してください。

matupo69
質問者

お礼

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

  • tom11
  • ベストアンサー率53% (134/251)
回答No.1

vbaでは、ないと、絶対駄目ですか???? ピポットテーブルで、簡単に出来るのですが、 図の様に、 データが変わっても、sample.xlsを保存して、 kekka.xlsを更新するだけなのですが。

matupo69
質問者

お礼

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

関連するQ&A

専門家に質問してみよう