| |
▼ponpon さん：
こんばんは。
>シート1のA列にコード(文字列）、B列に売上(数値）各見出しあり、
>同様にシート2のA列にコード(文字列）、B列に売上(数値）各見出しあり
>があります。
>
>シート1("田中"）
> A B
>1 コード 売上
>2 001234 2000
>3 001235 3000
>4 001236 300
>5 001237 4000
>6 …… ……
>
>シート2("山田"）
> A B
>1 コード 売上
>2 001233 2000
>3 001234 3000
>4 001237 300
>5 001238 4000
>6 …… ……
>シート1とシート2のA列には重複があります。
>各シートのA列には重複はありません。
>
>これをシート3("集計"）に
>A列に重複のないコードを、B列にコード別の売上(シート1）、
>C列にコード別の売上(シート2）のように集計したいのです。
> A B C
>1 コード 売上(田中) 売上(山田)
>2 001233 2000
>3 001234 2000 3000
>4 001235 3000
>5 001236 300
>6 001237 4000 300
>7 001238 4000
>8 …… ……
>
>そこで、以下のように組んだのですが、
>シート1だけにしかないものがうまく集計されません。
シート1だけにしかないitemは、
本来なら "3000,"
となっていなければなりませんが、
"3000"になっています。
>
>Splitで配列にして書き出しているので、
>Dic.Item(myVal(i, 1)) = myVal(i, 2)が配列にならないのだと思うのですが
>
Sub test1()
Dim SH1 As Worksheet, SH2 As Worksheet, SH3 As Worksheet
Dim Dic As Object
Dim i As Long, j As Long
Dim myVal, myVal2
Dim tarray As Variant
Set SH1 = Worksheets("田中")
Set SH2 = Worksheets("山田")
Set SH3 = Worksheets("集計")
Set Dic = CreateObject("Scripting.Dictionary")
myVal = SH1.Range("A2", SH1.Range("B65536").End(xlUp)).Value
myVal2 = SH2.Range("A2", SH2.Range("B65536").End(xlUp)).Value
For i = 1 To UBound(myVal, 1)
Dic.Add myVal(i, 1), Array(myVal(i, 2), "") 'ここがダメだと思う
Next
For j = 1 To UBound(myVal2, 1)
If Dic.Exists(myVal2(j, 1)) Then
tarray = Dic.Item(myVal2(j, 1))
tarray(1) = myVal2(j, 2)
Dic.Item(myVal2(j, 1)) = tarray
Else
Dic.Item(myVal2(j, 1)) = Array("", myVal2(j, 2))
End If
Next
With SH3
.Cells.ClearContents
.Range("A1:C1").Value = Array("コード", "売上(田中)", "売上(山田)")
i = 2
For Each key In Dic.keys()
.Cells(i, 1).Value = key
.Cells(i, 2).Resize(1, 2).Value = Dic.Item(key)
i = i + 1
Next
.Columns.AutoFit
.Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess
End With
End Sub
Itemとして配列をつかいました。
試して見てください。
|
|
ichinose
- 06/1/19(木) 23:59 -
