|
こんばんは。
> シートに下記のようなデータがあります。
>
> 品名 伝票NO 区分1 区分2 金額
> 10 11 A 1 10
> 11 11 B 1 20
> 12 11 A 1 30
> 13 22 A 1 40
> 14 33 A 1 50
> 15 55 B 1 60
> 16 55 A 1 70
> 17 77 A 1 80
入力データを記述したのですから、
この集計結果も記述してください。
> 別シートに
> 1.伝票NO計 2.伝票NO位置区分A合計 3.伝票NO位置区分B合計
↑これだけでは、何となくはわかってもはっきりとはわかりませんよね??
質問(煮詰まった)さんがこの記述を見た時にはっきりと結果が把握できますか?
それとこの問題は、Excelの持っている機能だけでも出来そうですけどね!!
Dictionaryを使用すると
標準モジュールに
'=========================================================
Sub main()
Dim kbun As Variant
Dim rng As Range
Dim crng As Range
Dim idx As Variant
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
Set rng = Range("b2", Cells(Rows.Count, "b").End(xlUp))
For Each crng In rng
If dic.Exists(crng.Text) Then
idx = Application.Match(crng.Offset(0, 1).Value, Array("A", "B"), 0)
If Not IsError(idx) Then
kbun = dic.Item(crng.Text)
kbun(idx - 1) = kbun(idx - 1) + crng.Offset(0, 3).Value
dic.Item(crng.Text) = kbun
End If
Else
kbun = Array(0, 0)
idx = Application.Match(crng.Offset(0, 1).Value, Array("A", "B"), 0)
If Not IsError(idx) Then
kbun(idx - 1) = crng.Offset(0, 3).Value
End If
dic.Add crng.Text, kbun
End If
Next
With ActiveSheet.Next
.Range("a1:c1").Value = Array("伝票NO", "区分A", "区分B")
.Range("a2", .Cells(UBound(dic.Keys) + 2, "a")).Value = Application.Transpose(dic.Keys)
.Range("b2", .Cells(UBound(dic.Items) + 2, "c")).Value = _
Application.Transpose(Application.Transpose(dic.Items))
End With
Set dic = Nothing
End Sub
提示されたシートをアクティブにした状態でmainを実行してみてください。
結果は、上記のシートの右隣のシートに記述します。
よって、右隣のシートをフリーにして置いてください。
提示されたシートのデータだと
右隣のシートに
伝票NO 区分A 区分B
11 40 20
22 40 0
33 50 0
55 70 60
77 80 0
こんな結果を作成します。
|
|