| |
こんばんは。
> シートに下記のようなデータがあります。
>
> 品名 伝票ＮＯ 区分１ 区分２ 金額
> １０ 11 A 1 10
> １１ 11 B 1 20
> １２ 11 A 1 30
> １３ 22 A 1 40
> １４ 33 A 1 50
> １５ 55 B 1 60
> １６ 55 A 1 70
> １７ 77 A 1 80
入力データを記述したのですから、
この集計結果も記述してください。
> 別シートに
> 1.伝票ＮＯ計 2.伝票ＮＯ位置区分Ａ合計 3.伝票ＮＯ位置区分Ｂ合計
↑これだけでは、何となくはわかってもはっきりとはわかりませんよね？？
質問（煮詰まった）さんがこの記述を見た時にはっきりと結果が把握できますか？
それとこの問題は、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("伝票ＮＯ", "区分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を実行してみてください。
結果は、上記のシートの右隣のシートに記述します。
よって、右隣のシートをフリーにして置いてください。
提示されたシートのデータだと
右隣のシートに
伝票ＮＯ 区分A 区分B
11 40 20
22 40 0
33 50 0
55 70 60
77 80 0
こんな結果を作成します。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
