![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
下記データの羅列がありますがこれをVBAで合算したいですのですが、
どのような構文にすれば良いかご教授頂けないでしょうか。
(今VBAでマクロを組んでいますが、それにこの処理を埋め込みたいです。)
1行目はタイトル行で2列目以降はデータ(間に空白行は存在しません)
A列 B列 C列 D列
1 日付 名前1 名前2 数量
2 2018/7/22 AAAA BBBB 500
3 2018/7/22 AAAA BBBB 700
4 2018/7/29 AAAA BBBB 500
5 2018/7/29 CCCC DDDD 500
6 2018/7/29 CCCC DDDD 500
↓A列,B列,C列が全て同じデータの場合、D列の数量を合算して一つにまとめる。
A列 B列 C列 D列
1 日付 名前1 名前2 数量
2 2018/7/22 AAAA BBBB 1200
3 2018/7/29 AAAA BBBB 500
4 2018/7/29 CCCC DDDD 1000
下記を参考にしようと思いましたがVBA初心者の為、複数条件の設定をどうすれば良いか
理解出来なかったためご教授お願いします。
https://detail.chiebukuro.yahoo.co.jp/qa/questio …
No.3ベストアンサー
- 回答日時:
こんばんは!
>データ量は13000ぐらいあります。
速度重視でやってみました。
元データはSheet1にあり、Sheet2に表示するとします。
標準モジュールです。
Sub Sample1()
Dim myDic As Object
Dim i As Long, lastRow As Long
Dim myStr As String, wS As Worksheet
Dim myKey, myItem, myR, myAry
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Range("A:D").ClearContents
With Worksheets("Sheet1")
wS.Range("A1:C1").Value = .Range("A1:C1").Value
wS.Range("D1") = "合計"
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(2, "A"), .Cells(lastRow, "D"))
For i = 1 To UBound(myR, 1)
myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3)
If Not myDic.exists(myStr) Then
myDic.Add myStr, myR(i, 4)
Else
myDic(myStr) = myDic(myStr) + myR(i, 4)
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
myR = Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "D"))
For i = 0 To UBound(myKey)
myAry = Split(myKey(i), "_")
myR(i + 1, 1) = myAry(0)
myR(i + 1, 2) = myAry(1)
myR(i + 1, 3) = myAry(2)
myR(i + 1, 4) = myItem(i)
Next i
Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "D")) = myR
Set myDic = Nothing
wS.Activate
MsgBox "完了"
End Sub
※ コードは長いですが、
そんなに時間は要しないと思います。m(_ _)m
No.6
- 回答日時:
No2です
>データ量多いのでやはりこれぐらいの時間はかかってしまうでしょうか?
すでに他の回答があるので、いまさらお答えする必要もないとは思いますが、そのようなことはありません。
処理の内容にもよりますけれど機械にとってはさほどの量ではないと思います。
No1にも記しましたが、
>どのような構文にすれば良いかご教授頂けないでしょうか。
とのことでしたので、できるだけ簡単な記述で済む方法にしています。
そのため、通常はあまり使わないであろう方法での処理になっています。
そのかわりに、VBAの記述は、単純なステートメントを順に記述すればよい形式になっていると言えます。
(まぁ、ほとんどの計算を関数式にやらせているので、VBAは手順だけの記述で済む)
通常は、他の方の回答のような発想で処理すると思いますが、「構文がわからない」という質問者様には考え方を説明しても伝わらない可能性があると思いましたので・・・
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_14.png?5a7ff87)
No.5
- 回答日時:
No4です。
標準モジュールに登録してください。------------------------------------------------------------
Option Explicit
Public Sub 重複データ合算()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As Variant
Dim dicT As Object
Dim t1, t2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set dicT = CreateObject("Scripting.Dictionary")
t1 = Time
sh2.Cells.Clear
maxrow1 = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
sh2.Range("A1:D1").Value = sh1.Range("A1:D1").Value
maxrow2 = 2
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "A").Value & "|" & sh1.Cells(row1, "B").Value & "|" & sh1.Cells(row1, "C").Value
If dicT.Exists(key) = False Then
dicT(key) = maxrow2
sh2.Range("A" & maxrow2 & ":D" & maxrow2).Value = sh1.Range("A" & row1 & ":D" & row1).Value
maxrow2 = maxrow2 + 1
Else
row2 = dicT(key)
sh2.Cells(row2, "D").Value = sh2.Cells(row2, "D").Value + sh1.Cells(row1, "D").Value
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
t2 = Time
MsgBox ("処理時間=" & Format(t2 - t1, "n分s秒"))
End Sub
No.2
- 回答日時:
No1です
実際になさりたいことは何なのかよくわかりませんが、元データを削除するような雰囲気になっているようなので、もしも、それでよいのでしたなら・・・
※ 削除はせずに、対象行を選択した状態にしています。
※ A列は必ず2行目以降までデータがあるものと仮定しています。
(データ無しのチェックはしていません)
Set R = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 4)
R.FormulaLocal = "=IF(COUNTIFS($A$2:A2,A2,$B$2:B2,B2,$C$2:C2,C2)>1,"""",SUMIFS(D:D,A:A,A2,B:B,B2,C:C,C2))"
R.Value = R.Value
R.SpecialCells(xlCellTypeBlanks).EntireRow.Select
ありがとうございます。
やりたいことの動作的にはご提供頂きました構文であっています。
処理が早くなりましたが、3分ほど時間が掛かってしまうようですが、
データ量(13000ぐらい)多いのでやはりこれぐらいの時間はかかってしまうでしょうか?
(ちょっと強引?ですが、処理時間が掛かるようであればピボットテーブル作成を
VBAに組み込んでみようと思っています。)
Dim t1, t2, t3
t1 = Time
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set R = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 4)
R.FormulaLocal = "=IF(COUNTIFS($A$2:A2,A2,$B$2:B2,B2,$C$2:C2,C2)>1,"""",SUMIFS(D:D,A:A,A2,B:B,B2,C:C,C2))"
R.Value = R.Value
R.SpecialCells(xlCellTypeBlanks).EntireRow.Select
Application.Calculation = xlCalculationAutomatic
t2 = Time
Selection.Delete Shift:=xlToLeft
t3 = Time
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("FINISH TIME1=" & Format(t2 - t1, "n分s秒") _
& vbCrLf & _
"FINISH TIME2=" & Format(t3 - t2, "n分s秒"))
上記で、FINISH TIME1が2分30秒ぐらい、FINISH TIME2が45秒ぐらいです。
No.1
- 回答日時:
こんにちは
>どのような構文にすれば良いかご教授頂けないでしょうか。
普通に処理すると、重複をチェックしたり検索集計したりとそれなりに面倒なので、通常はあまりやらないかも知れませんが、VBA的には比較的簡単な例を
1)E列を作業列に利用します。
(E列が使われている場合は、Columns(5).Insert などで挿入)
2)使用セルの最下行を求める。
Cells(Rows.Count, 1).End(xlUp)など
3)対象範囲の各行E列に以下の式を設定
関数式の設定は、Range().FormulaLocal = 式 などで可能
設定する関数式は
=IF(COUNTIFS($A$2:A2,A2,$B$2:B2,B2,$C$2:C2,C2)>1,"",SUMIFS(D:D,A:A,A2,B:B,B2,C:C,C2))
以上のセッティングができれば、E列に結果が表示されますので、E列を調べて値のある行だけピックアップすれば、お望みの結果となるでしょう。
例えば、結果を別のシートに抽出するなら、
For Each c In E列の範囲
If c.value <> "" Then この行を書き写す処理
Next c
のような感じで可能でしょう。
最後に、E列を削除(あるいは値をクリア)しておけば、データのシートは元の状態になります。
ありがとうございます。
「例えば~」がどうすれば良いかわからなかったので、計算結果をコピー→値貼り付け→0の結果のところ
(IF文の空白だとうまくいかなかったので0にしています)を削除みたいにしてみましたが、値を貼り付け
のところで5分ぐらいかかってしまいました・・・。
データ量は13000ぐらいあります。
Application.Calculation = xlCalculationManual
Range("E1").Formula = "合計数量"
Range("E2").Formula = _
"=IF(COUNTIFS($A$2:A2,A2,$B$2:B2,B2,$C$2:C2,C2)>1,0,SUMIFS(D:D,A:A,A2,B:B,B2,C:C,C2))"
Range(Cells(2, 5), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 5)).FillDown
ActiveSheet.Calculate
Range(Cells(2, 5), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 5)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim LastRow1 As Long
LastRow1 = Cells(Rows.Count, "E").End(xlUp).Row
With ActiveSheet
.Range("E:E").AutoFilter Field:=1, Criteria1:="0"
If .Cells(Rows.Count, "E").End(xlUp).Row > 1 Then
Range(.Cells(2, "E"), .Cells(LastRow1, "E")).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
.AutoFilterMode = False
End With
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAで重複データを合算したい(時間) 1 2022/12/08 23:06
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 3 2022/06/12 11:17
- Visual Basic(VBA) 複数シートの複数列に入力されているデータを重複なしで抽出するVBAを作りたいです。 9 2022/06/17 10:33
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) VBAで、シート間の転記するコードをFOR~NEXTで教えてください。 9 2023/04/30 20:04
- Visual Basic(VBA) 【VBA】複数行あるカンマ区切りのデータを全て縦に一列に並べたい 5 2022/04/13 17:03
- Visual Basic(VBA) 【困っています2】VBA 追加処理の記述を教えてください。 2 2022/08/26 11:42
- Excel(エクセル) VBA セルの値と同じ名前のシートにデータを貼り付けするやり方を教えてください 2 2022/05/17 16:26
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
VBAで重複する項目を1つにまとめて金額を合計したい
Excel(エクセル)
-
重複行を削除して数値を合算したい(合算列が多い)
Excel(エクセル)
-
重複データの合算(VBA)
Visual Basic(VBA)
-
-
4
VBAで重複するデータがあれば1個だけ残して他の重複セルを"(空白)にしたいのですが
Excel(エクセル)
-
5
VBA 重複データの合計
Excel(エクセル)
-
6
vba 重複データ合算
Visual Basic(VBA)
-
7
重複するIDのデータを1行にまとめるvbaのコード
Access(アクセス)
-
8
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
9
EXCEL 重複データの集計の仕方
Excel(エクセル)
-
10
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
11
エクセル マクロで数値が変った時行挿入できますか
Excel(エクセル)
-
12
VBA 値と一致した行の一部の列のデータを転記について教えてください
Visual Basic(VBA)
-
13
【EXCEL】【VBA】空欄は飛ばして処理する方法を教えて下さい。
Excel(エクセル)
-
14
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
15
EXCEL VBAで、セルの文字列の前後に文字を入力する方法は?
その他(Microsoft Office)
-
16
エクセルVBAでセルに入力したパスでブックを開く
Excel(エクセル)
-
17
UserForm1.Showでエラーになります。
工学
-
18
エクセルで重複するセル合計を別シートへ自動記入
Excel(エクセル)
-
19
【VBA】条件に一致しない行を削除したい
Visual Basic(VBA)
-
20
【VBA】2つのシートの値を比較して条件一致したら、同じ行の隣の値を別ブックへ転記したいです。 VB
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel関数-文字列で自動作成さ...
-
エクセルの関数について教えて...
-
Excelデータをコピペして、ペー...
-
職場の人から聞かれており、こ...
-
ユーザー定義関数をアドイン登...
-
Excelで50個のセルに同じ文字を...
-
スプレッドシート、Excelでの数...
-
Microsoft Officeの中古は信用...
-
エクセルで不等号記号(≠)が上に...
-
スプレッドシートで使う数式を...
-
エクセルでの特別な文字を上に...
-
エクセル日付 文字列の関数がエ...
-
A列とB列を参照してC列に連番を...
-
エクセルVBA、別ブックへ転記す...
-
各ページの1番上の表示について
-
エクセルでセルに標準で入力さ...
-
EXCELの質問です 119から足した...
-
pdfの表をexcelにはりつけて計...
-
Excelのif関数で文字が見えなく...
-
【マクロ】アクティブセルにブ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA、別ブックへ転記す...
-
エクセルでの作業計算方法について
-
時間によってファイル名が変わ...
-
【関数】適切な文字数の数字を...
-
Excelについて教えてください
-
エクセル初心者です 関数の入れ...
-
【マクロ】ファイル名の変更に...
-
UNIQUE関数が使えないバージョ...
-
エクセルの計算
-
【関数】先頭だけにある、半角...
-
Excelで、決まった行を繰り返し...
-
Excelでセルの値が同じか...
-
LOOKUP関数を使えばいいのでし...
-
Excel
-
はがきについて。
-
エクセルの条件付き書式につい...
-
エクセルのデーターが2か月前の...
-
エクセル②
-
エクセルで「-0.0」と表示さ...
-
Microsoft1Officeの互換ソフト...
おすすめ情報