[[20160524133916]]　『注文情報を2期比較したい』（kobeyan）　ページの最後に飛ぶ

『注文情報を2期比較したい』（kobeyan）

注文の受注額の２期比較をしたいとおもっています。

随時入る1年更新の注文（一定期間の契約。だいたい1年。）を、年度ごとにシートを分けて、１件１行で注文情報を入力しています。
注文情報には注文日、固有番号、注文名、内容、金額などを記載。
この中で固有のキーとして使っているのは「固有番号」。注文名、内容は年度により表記ゆれがあります。
毎年同一の「固有番号」で同一の注文が入ることが多いが、減額したり、増額したり、ある年はその注文が無かったり、同一番号で複数の注文に分割したり、あるいは新たな固有番号で新規受注したりと様々。

したいことは今期2016年度と前期2015年度で固有番号ごとに減額なのか、増額なのか、キャンセル(未受注)なのか、今までなかった固有番号が増えた(新規もしくは番号変更)のかを比較したい。
以下、イメージしているものです。

番号 2015年受注額 2016年受注額増減した額状態
xxxxxx 120000円　 140000円　　 20000円　増額
yyyyyy 200000円　　 0円　　 -200000円解約

やってみたことは、2015年度をマスターに使って固有番号を検索キーとして、vlookup関数で2016年度の注文情報を引っ張ってきた。この方法だと同番号で減額、増額、キャンセルになった場合はわかるのだが、分割された場合や新規注文はわかりません。

アドバイスをいただけないでしょうか。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

Sub main()

    Dim dic, dic2, sht(2) As Worksheet, i As Long, j As Long, k, strj As Long, mxj As Long

    Set sht(0) = Sheets("2015") '適宜変更してください
    Set sht(1) = Sheets("2016") '適宜変更してください
    Set sht(2) = Sheets("比較表") '適宜変更してください
    固有番号列 = 2 '適宜変更してください
    金額列 = 5 '適宜変更してください

    Set dic = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    For i = 0 To 1
        For Each c In Intersect(sht(i).UsedRange, sht(i).Columns(固有番号列)).Cells
             dic(c.Value) = True
        Next c
    Next i
    sht(2).Cells.ClearContents
    j = 2
    sht(2).Range("A1:E1") = Array("番号", "2015年受注額", "2016年受注額", "増減した額", "状態")
    For Each k In dic.keys
        If k <> "固有番号" And Len(k) > 0 Then
            sht(2).Cells(j, 1) = k
            strj = j

                For i = 0 To 1
                    For Each c In Intersect(sht(i).UsedRange, sht(i).Columns(固有番号列)).Cells
                        If c.Value <> "" And c.Value = k Then
                         sht(2).Cells(j, i + 2) = c.Offset(, 金額列 - 固有番号列)
                         dic2(k) = dic2(k) + c.Offset(, 金額列 - 固有番号列) * IIf(i = 0, -1, 1)

                         j = j + 1
                         mxj = Application.WorksheetFunction.Max(j, mxj)
                        End If
                    Next c
                    j = strj
                Next i

                If sht(2).Cells(strj, 2) = "" Then
                sht(2).Cells(strj, 5) = "新規": sht(2).Cells(strj, 4) = sht(2).Cells(strj, 3)
                Else
                    If sht(2).Cells(strj, 3) = "" Then
                    sht(2).Cells(strj, 5) = "解約": sht(2).Cells(strj, 4) = sht(2).Cells(strj, 2) * -1
                    Else
                        If dic2(k) > 0 Then sht(2).Cells(strj, 5) = "増額": sht(2).Cells(strj, 4) = dic2(k)
                        If dic2(k) < 0 Then sht(2).Cells(strj, 5) = "減額": sht(2).Cells(strj, 4) = dic2(k)
                        If dic2(k) = 0 Then sht(2).Cells(strj, 5) = "同額": sht(2).Cells(strj, 4) = dic2(k)
                    End If
                End If

        End If
        mxj = mxj - strj
        j = j + mxj
        mxj = 0
    Next k
End Sub
（mm） 2016/05/24(火) 16:08

コメント返信：

[ 一覧(最新更新順) ]

[[20160524133916]] 『注文情報を2期比較したい』（kobeyan） ページの最後に飛ぶ

[[20160524133916]]　『注文情報を2期比較したい』（kobeyan）　ページの最後に飛ぶ