エクセル よい集計方法ないでしょうか？

質問

エクセル　よい集計方法ないでしょうか？

順番の小さい方から、同じ種類ごとにまとめて1行でリストを作る仕事があります。
今は手作業で書式通りに変更しているのですが、
関数やマクロをつかって、間違いのないよう正しい指定書式通りに集計できるよい方がないでしょうか？

元の資料

A列（番号）｜Ｂ列（種類）｜Ｃ列（個数）｜　　
　1　　　　｜丸　　　　　｜1個　　　 　｜　
　2　　　　｜三角　　　　｜1個　　　 　｜
　3　　　　｜三角 　　 　｜1個　　　 　｜　
　4-9　　　｜三角　　　　｜6個　　　 　｜　　
　10　　　 ｜丸　　　　　｜1個　　　 　｜

作成したい資料

　A列（番号）｜Ｂ列（種類）｜Ｃ列（個数）｜　
　　1　　　　｜丸　　　　　｜1個　　　 　｜　
　　2-9 　｜三角　　 　｜8個　　　 　｜　　
　　10　　　 ｜丸　　　　　｜1個　　　 　｜

商品を受入れた順番毎に種類と個数が登録されています。
番号は”商品受入日順”と決まっているので、種類別に番号を振ることはできません。

最終的に番号順/種類順で何個の商品があるのかを集計する必要あります。
これも指定の書式で社外に出すために変更できません。

元資料は1商品に対して1行ではなく、5行目のように、
「4～9番として　三角の商品を　6個受入」と1行にまとめられています。
ピボットを使って、と何回か段階を経て作業することも考えたのですが・・・。

なんとか、うまく処理できるアイデアをいただければと思います。
よろしくお願いします！！

ちなみに、自分はマクロは記憶させるマクロのみつかえるレベルです。

回答No.1

KURUMITO · ベストアンサー

元の資料がシート1に有るとします。
シート1では作業列を2列使用します。
Ｄ2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(A2="","",IF(B2<>B3,MAX(D$1:D1)+1,""))

Ｅ2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(A2="","",IF(B2<>B1,A2&"a"&B2&"b"&C2,IF(AND(B2=B1,B2=B3),LEFT(E1,FIND("b",E1))&MID(E1,FIND("b",E1)+1,5)*1+C2,IF(AND(B2=B1,B2<>B3),LEFT(E1,FIND("a",E1)-1)&"-"&IF(COUNTIF(A2,"*-*")=0,A2,MID(A2,FIND("-",A2)+1,5)*1)&"a"&B2&"b"&MID(E1,FIND("b",E1)+1,5)*1+C2,""))))

お求めの表はシート2に作成することにしてＡ1セルには番号、Ｂ1セルには種類、Ｃ1セルには個数と入力します。

Ａ2セルには次の式を入力してＣ2セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(COUNTIF(Sheet1!$D:$D,ROW(A1))=0,"",IF(COLUMN(A1)=1,LEFT(INDEX(Sheet1!$E:$E,MATCH(ROW(A1),Sheet1!$D:$D,0)),FIND("a",INDEX(Sheet1!$E:$E,MATCH(ROW(A1),Sheet1!$D:$D,0)))-1),IF(COLUMN(A1)=2,INDEX(Sheet1!$B:$B,MATCH(ROW(A1),Sheet1!$D:$D,0)),IF(COLUMN(A1)=3,MID(INDEX(Sheet1!$E:$E,MATCH(ROW(A1),Sheet1!$D:$D,0)),FIND("b",INDEX(Sheet1!$E:$E,MATCH(ROW(A1),Sheet1!$D:$D,0)))+1,5)*1,""))))

お礼

KURUMITO様、ありがとうございます！
すごいです！希望していた通りの表ができました。
自分でしっかりと理解しなくては、と今まで格闘・・・お礼が遅くなり申し訳ありません。

箱の順番とサイズごとに番号をふれる方法、まだ自分のものにはできていないのですが、しっかりと覚えたいと思います。

また、１点お教えいただきたい事があります。
関数ＭＩＤで文字列を引っ張る際カケル1する箇所がありますが、これはどうしてこの作業をするのでしょうか？

少しずつ関数の考え方やコツ（？）を身につけたいと思います。

回答No.4

KURUMITO

回答Ｎｏ1です。

MID(E1,FIND("b",E1)+1,5)*1

ＭＩＤ関数の件ですがこの関数で引き出される答えは文字列ということになっています。＊1としているのは文字列の値を数値に変換する操作です。私の示した式では答えに別の数値をプラスする計算ですので、文字列のままでも計算してくれると思いますので＊1は必ずしも必要はないでしょう。数値をプラスするような場合には文字列のままでもよいでしょうが掛けるなどの場合には文字列と数値を掛けるとエラーになってしまいます。このようなことを避けるためにはＭＩＤ関数で求めた数字は必ず＊1で数値に直しておくことが間違いのない方法です。

お礼

ありがとうございます！

文字列・数値といったことを今まであまり意識していませんでした。
このようにしておくことで今後色々計算する際にエラーが出ないようにするのですね。
大変勉強になりました。

いただいた関数を大事に仕事に活かしたいと思います。

ありがとうございました。

回答No.3

Wendy02

本来は、マクロのための情報が足りません。しかし、あれこれ聞くまえに、コードを試してみて、その反応を見たほうが早いような気がしました。(ここは、マクロを教える場所ではないからですが。）

'//標準モジュール
Sub ListReArrange()
Dim Ar1() As String, Ar2() As String, Ar4 As Variant
Dim iStart　As Long, iLast　As Long, iCol As Long
Dim i As Long, j As Long, n As Long
Dim num As Variant
Dim DistRng As Range

'要設定-データのスタート行: データのスタート列
iStart = 2: iCol = 1
'要設定-貼りつけ場所
Set DistRng = Worksheets("Sheet2").Cells(iStart,"A")

If DistRng.Value <> "" Then
　If MsgBox("貼り付け場所のデータを削除します。", vbQuestion + vbOKCancel) = vbCancel Then
　　 Exit Sub
　End If
End If
DistRng.CurrentRegion.ClearContents
If iStart > 1 Then
　Cells(iStart - 1, iCol).Resize(, 3).Copy DistRng.Offset(-1)
End If
iLast = Cells(Rows.Count, iCol).End(xlUp).Row
'戻し
For i = iStart To iLast
　If IsNumeric(Cells(i, iCol).Text) Then
　　ReDim Preserve Ar1(j): Ar1(j) = Cells(i, iCol).Value
　　ReDim Preserve Ar2(j): Ar2(j) = Cells(i, iCol + 1).Value
　　j = j + 1
　Else
　　num = Split(Cells(i, iCol).Text, "-", , 1)
　　For n = num(0) To num(1)
　　　ReDim Preserve Ar1(j): Ar1(j) = n
　　　ReDim Preserve Ar2(j): Ar2(j) = Cells(i, iCol + 1).Value
　　　j = j + 1
　　Next
　End If
Next
　'最終データ
　ReDim Preserve Ar1(j): Ar1(j) = ""
　ReDim Preserve Ar2(j): Ar2(j) = ""
　Ar4 = ReArrange(Ar1, Ar2)
　'シートに貼り付け
　With DistRng.Resize(UBound(Ar4) + 1, 3)
　 .Cells = Application.Transpose(Ar4)
　 .Columns(1).HorizontalAlignment = xlCenter
　 .Columns(3).NumberFormatLocal = "#,##0個"
　End With
　Beep '終了
End Sub
Private Function ReArrange(Ar1() As String, Ar2() As String)
　'再正規化
　Dim Ar3() As Variant
　Dim i As Long, j As Long
　Dim iSt As Long
　ReDim Ar3(2, UBound(Ar1))
　For i = LBound(Ar1) To UBound(Ar1) - 1
　　Do
　　　If iSt = 0 Then
　　　　iSt = Ar1(i)
　　　End If
　　　If Ar2(i) <> Ar2(i + 1) Then Exit Do
　　　i = i + 1
　　Loop
　　If iSt <> Ar1(i) Then
　　　Ar3(0, j) = "'" & iSt & "-" & Ar1(i)
　　　Ar3(2, j) = Ar1(i) - iSt + 1
　　Else
　　　Ar3(0, j) = iSt
　　　Ar3(2, j) = 1
　　End If
　　Ar3(1, j) = Ar2(i)
　　iSt = 0
　　j = j + 1
　Next i
　ReDim Preserve Ar3(2, j - 1)
　ReArrange = Ar3
End Function

お礼

Wendy02様、ありがとうございます。
言葉の足りない質問に、丁寧に回答いただきたき嬉しいです。
今、ようやく関数での対応方法を理解しかけてきたところです。

Wendy02様のマクロを理解できるまでまだまだ努力と時間がかかりそうです。
必ず自分のものにするよう、ぶつかってみたいと思います。

うまくできました、のご報告もできないままで恐縮ですが
本当にありがとうございました。

回答No.2

KURUMITO

回答Ｎｏ1です。

もしも、エラー表示が出るとしたらＡ列での2-9が2～9のようになっているとしたらお示しした式で"-"は"～"のように変更することが必要ですね。また、セルに2-9のように直接入力すれば日付の入力と判断されてしまいますのでセルを書式を文字列として入力するかあるいは'を頭に付けて'2-9のように入力することが必要ですね。

なお結果の表示でＣ列の個数を1個などと表示させるのでしたら、Ｃ列を選択してから「セルの書式設定」で「表示形式」の「ユーザー定義」で、種類の窓には　0"個" と入力します。