IDと名前が同じのデータの価格を合算するVBコード

ID 　 名前　　　　価格
1 　name1 　　　10
2 　name2 　　　12
1 　name1 　　　20
2 　name2 　　　20
3 　name2 　　　10
2 　name1 　　　10
.
.
↓
1 　name1 　　　30
2 　name2 　　　32
2 　name1 　　　10
3 　name2 　　　10
その加算後の価格が取得したいです。
どなたかこのような処理のvbのコードを教えてください。
よろしくお願いします。

No.5 回答者： めぐみん_ 回答日時： 2017/11/29 14:11

No.4です。

VBってVisualStudioの.NETと思ってましたけど、もしやVB6.0とかだったりします？

No.4 回答者： めぐみん_ 回答日時： 2017/11/28 19:22

No.3です。

まずはお礼の件について。

＞質問した際に、VBの分類はないので、一旦VBAを選択しました。

カテゴリ的にはここで間違いないのですが、ＶＢＡも含んでＶＢとなってます。
質問される際にＶＢ２０××などと書いてあれば良かったかなと思います。
または『データはＣＳＶ』とあると、Excelのシートと勘違いは無かったかな？

取り敢えず区切り文字とエンコードが不明なのと検証用に作成したPathとファイル名については、適宜修正をお願いします。
結果は『出力画面』に出してます。

　　Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
　　　　Dim myDic As New SortedDictionary(Of String, Object())

　　　　'CSVファイルのあるフォルダ
　　　　Dim csvDir As String = "D:\"
　　　　'読込むCSVファイルの名前
　　　　Dim csvFileName1 As String = "abc.csv"

　　　　Dim csvRead As New FileIO.TextFieldParser(csvDir + csvFileName1, System.Text.Encoding.GetEncoding("Shift_JIS"))
　　　　csvRead.TextFieldType = FileIO.FieldType.Delimited
　　　　csvRead.Delimiters = New String() {","} '区切り文字はカンマ

　　　　Dim fields As Object() = csvRead.ReadFields()
　　　　Dim st As String

　　　　Console.WriteLine("{0}　{1}　　{2}", fields(0), fields(1), fields(2))

　　　　While Not csvRead.EndOfData
　　　　　　fields = csvRead.ReadFields()
　　　　　　st = fields(0) + "_" + fields(1)

　　　　　　If Not myDic.ContainsKey(st) Then myDic.Add(st, New Object() {fields(0), fields(1), 0})

　　　　　　myDic(st)(2) = (Integer.Parse(myDic(st)(2)) + fields(2)).ToString
　　　　End While

　　　　csvRead.Close()

　　　　For Each item() As Object In myDic.Values
　　　　　　Console.WriteLine("{0}　{1}　　{2}", item(0), item(1), item(2))
　　　　Next

　　End Sub

－－－－出力結果－－－－
ID　名前　　価格
1　name1　　30
2　name1　　10
2　name2　　32
3　name2　　10

－－－－－－－－－－－－

キーの繋がりの関係で名前も並び変わってしまってます。
ごめんなさい。

No.3 回答者： めぐみん_ 回答日時： 2017/11/28 16:38

No.2です。

【名前】の並べ替え必要なかったのですね。

ところでExcelであればVBAと提示された方が宜しいかと。
VBとは違いますので。
でもこれが実はVBで、CSV等からデータを集めるのであれば別ですが。

この回答へのお礼

ご回答ありがとうございます。
実はVBで、CSVをアップロード時の処理です。
質問した際に、VBの分類はないので、一旦VBAを選択しました。

お礼日時：2017/11/28 18:02

No.2 回答者： めぐみん_ 回答日時： 2017/11/28 16:34

Excelなのか否かが不明ですが。

まずはExcelとして。

A~C列１行目からデータがあるとしてE~G列に纏めるのであれば、

Sub try()
　Dim myDic As Object
　Dim r As Range
　Dim v, st As String

　Set myDic = CreateObject("Scripting.Dictionary")

　For Each r In Range("A2", Cells(Rows.Count, 1).End(xlUp))
　　st = r.Value & "_" & r.Range("B1").Value
　　If Not myDic.Exists(st) Then myDic.Add st, Array(r.Value, r.Range("B1").Value, 0)
　　v = myDic(st)
　　v(2) = v(2) + r.Range("C1").Value
　　myDic(st) = v
　Next

　Range("E1:G1").Value = Range("A1:C1").Value
　Range("E2").Resize(myDic.Count, 3).Value = Application.Transpose(Application.Transpose(myDic.Items))
　Columns("E:G").Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("F2") _
　, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1

　Set myDic = Nothing
End Sub

ご参考程度ですが。

No.1 回答者： tom04 回答日時： 2017/11/28 15:05

こんにちは！

ExcelのVBAというコトで良いのでしょうか？

一例です。
元データはSheet1にあり、Sheet2に表示するとします。
尚、質問文通り1行目が項目行でデータは2行目以降にあるという前提です。

標準モジュールです。

Sub Sample1()
Dim myDic As Object
Dim myKey, myItem, myVal, myR, myAry
Dim i As Long, lastRow As Long, wS As Worksheet

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Range("A:C").ClearContents
With Worksheets("Sheet1")
wS.Range("A1:C1").Value = .Range("A1:C1").Value
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(2, "A"), .Cells(lastRow, "C"))
For i = 1 To UBound(myR, 1)
myVal = myR(i, 1) & "_" & myR(i, 2)
If Not myDic.exists(myVal) Then
myDic.Add myVal, myR(i, 3)
Else
myDic(myVal) = myDic(myVal) + myR(i, 3)
End If
Next i
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myAry = Split(myKey(i), "_")
wS.Cells(i + 2, "A") = myAry(0)
wS.Cells(i + 2, "B") = myAry(1)
wS.Cells(i + 2, "C") = myItem(i)
Next i
End With
wS.Range("A1").CurrentRegion.Sort key1:=wS.Range("A1"), order1:=xlAscending, Header:=xlYes
Set myDic = Nothing
MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございました。
ただ、これはエクセルではなく、VBでCSVのデータのまとめ処理ですが。

お礼日時：2017/11/28 18:06