[[20190305120757]]　『表の作成方法』（初心者）　ページの最後に飛ぶ

『表の作成方法』（初心者）

表を作成する方法。

材料表を作成するように上司に頼まれました。

もとの表は色々データが入っているのですが

Ａ列→商品名
Ｋ列→材料（01たまご、11お米、91ソース・・・）
　　　　（今、２００種類くらいの材料が入力されています。
　　　　　材料の前の数字は項目番号です。調味料は90番台など）

この二つのデータを２種類の表にしたいのです。

新しくシートを作成し、

（商品ごと）シート
Ａ列→商品名をあいうえお順に
Ｂ列以降→材料名をあいうえお順で材料分のセルを作成する。
　　　　　　　商品名の入力されている行が該当があれば（〇）を入力。

（材料ごと）シート
Ａ列→材料名あいうえお順に
Ｂ列以降→商品名をあいうえお順に
　　　　　　　材料の入力されている行が該当があれば（〇）を入力。

関数やピポットテーブル？を使えば作れるのでしょうか？

さっぱりわからずに、今一個ずつ見ながら転記しているのですが
訳が分からなくなってきていて困っています。

どなたか、アドレス頂けますか？

よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

 説明だけではぼんやりなので、具体的な例をあげてもらえますか？
（コナミ） 2019/03/05(火) 12:45

コナミさま、お返事ありがとうございます。
具体的な例書いてみます。変な箇所があったらご指摘ください。

「元シート」

    Ａ列/Ｋ列
1/商品名/材料
2/目玉焼き/22卵、92塩
3/アイス/23牛乳、21砂糖
4/カップケーキ/01小麦粉、21砂糖、31バター

「商品ごとシート」

    Ａ列/Ｂ列/Ｃ列/Ｄ列。。。。
1/商品名/01小麦粉/21砂糖/22卵/。。。。
2/アイス//〇//。。。
3カップケーキ/◯/◯//。。。
4目玉焼き///◯/。。。

「材料ごとシート」
Ａ列/Ｂ列/Ｃ列/Ｄ列。。。。
1/材料名/アイス/カップケーキ/目玉焼き/。。。。
2/01小麦粉//◯//。。。
3/21砂糖/◯/◯//。。。
4/22卵//◯/◯//。。。

こんな感じで大丈夫でしょうか？
（初心者） 2019/03/05(火) 13:07

 シート名:元 				
 	A　　　　　　　K		
 1　　商品名　 　　　 材料		
 2　 目玉焼き　　　22卵、92塩		
 3　　アイス　　 　23牛乳、21砂糖		
 4　カップケーキ　 01小麦粉、21砂糖、31バター

 シート名:商品							
 	A　　　　　B　　　　　C　　　　　D
 1　　商品名　　01小麦粉　　21砂糖　　　22卵
 2　　アイス
 3　カップケーキ
 4　 目玉焼き

 シート名:材料				
 	A　　　　B　　　　　　C　　　　　　D
 1　　材料名　アイス　　カップケーキ　　目玉焼き
 2　 01小麦粉
 3　 21砂糖
 4　　22卵

 商品シートのB2:=IF(SUMPRODUCT((元!$A$2:$A$4=$A2)*ISNUMBER(FIND(B$1,元!$K$2:$K$4))),"○","")
 右方向と下方向にコピー

 材料シートのB2:=IF(SUMPRODUCT(ISNUMBER(FIND($A2,元!$K$2:$K$4))*(元!$A$2:$A$4=B$1)),"○","")
 右方向と下方向にコピー

 $A$2:$A$4などは実際のデータ範囲に変えてください。
（bi） 2019/03/05(火) 13:34

ｂｉさまコメントありがとうございます。
関数のご教授ありがとうます。
一点質問させていただきたいのですがＡ列のデータは一個づつ転記する以外に何か方法がありますでしょうか？
商品名はすぐできるのですが、材料名の抽出が転記にすごく時間がかかりそうです。
色々お聞きして申し訳ありませんがよろしくお願いします。
（初心者） 2019/03/05(火) 16:05

 Sub データ整理()

     Dim tmp As Variant
     Dim i As Long, cnt As Long, col As Long
     Dim c As Range
     Dim hani As String

     Application.ScreenUpdating = False

     Sheets.Add After:=Sheets(Sheets.Count)
     ActiveSheet.Name = "作業シート"

     With Sheets("作業シート")
          Sheets("元").Columns("K").Copy .Columns("A")
          col = 2
          For r = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
              tmp = Split(Cells(r, 1).Value, "、")
              For i = LBound(tmp) To UBound(tmp)
                  Cells(r, col).Value = tmp(i)
                  col = col + 1
              Next i
              col = 2
          Next r
          .Columns("A").ClearContents
          hani = .Range("B2").CurrentRegion.Address
          For Each c In .Range(hani)
              If c <> "" Then
                 cnt = cnt + 1
                 .Cells(cnt, "A") = c
              End If
          Next c
          .Range(.Columns(2), .Columns(300)).ClearContents
          .Columns("A:A").Range("$A$1:$A$" & .Cells(.Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
          .Columns("A").Sort key1:=.Range("A1"), Order1:=xlAscending
     End With

     Application.ScreenUpdating = True

 End Sub

 作業シートに材料名の一覧が出るようになっています。
 作業シートのA列をコピーして行列入れ替えで貼り付けてください。
 ちなみにこのコードは私が一から考えたものではなくネットから情報を拾ってきて一部加工したものです…。

 コード内容はこちらを参考にさせていただきました。
http://officetanaka.net/excel/vba/tips/tips62.htm
https://oshiete.goo.ne.jp/qa/9285234.html
（bi） 2019/03/05(火) 17:10　修正17:19

Sub main()

 '元データはSheet1にある前提
 '材料の区切り文字は "、"
    Dim ast As Worksheet, sht As Worksheet, dic As Object, c As Range, i As Long
    Set ast = Sheets("Sheet1")
    For Each sht In Worksheets
        If sht.Name = "商品ごと" Or sht.Name = "材料ごと" Then Application.DisplayAlerts = False: sht.Delete
    Next sht
    Set dic = CreateObject("Scripting.Dictionary")
    Sheets.Add after:=ast
    ActiveSheet.Name = "商品ごと"
    Sheets.Add after:=ast
    ActiveSheet.Name = "材料ごと"
    For Each c In ast.Range("A1:A" & Rows.Count).SpecialCells(2)
        Sheets("商品ごと").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = c.Value
        For i = 0 To UBound(Split(c.Offset(, 10).Value, "、"))
            dic(Split(c.Offset(, 10).Value, "、")(i) & Chr(2) & c.Value) = True
            If Sheets("材料ごと").Range("A:A").Find(Split(c.Offset(, 10).Value, "、")(i), , , xlWhole) Is Nothing Then
                Sheets("材料ごと").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Split(c.Offset(, 10).Value, "、")(i)
            End If
        Next i
    Next c
    With Sheets("材料ごと").Sort
        .SortFields.Add Key:=Sheets("材料ごと").Range("A1")
        .SetRange Sheets("材料ごと").Range("A2:A" & Rows.Count)
        .Apply
    End With
    With Sheets("商品ごと").Sort
        .SortFields.Add Key:=Sheets("商品ごと").Range("A1")
        .SetRange Sheets("商品ごと").Range("A2:A" & Rows.Count)
        .Apply
    End With
    Sheets("材料ごと").Range("A:A").SpecialCells(2).Copy
    Sheets("商品ごと").Range("B1").PasteSpecial , Transpose:=True
    Sheets("商品ごと").Range("A:A").SpecialCells(2).Copy
    Sheets("材料ごと").Range("B1").PasteSpecial , Transpose:=True
    For Each c In Sheets("材料ごと").Range("A1").CurrentRegion.SpecialCells(4)
        If dic(c.EntireRow.Cells(1) & Chr(2) & c.EntireColumn.Cells(1)) = True Then c.Value = "○"
    Next c
    For Each c In Sheets("商品ごと").Range("A1").CurrentRegion.SpecialCells(4)
        If dic(c.EntireColumn.Cells(1) & Chr(2) & c.EntireRow.Cells(1)) = True Then c.Value = "○"
    Next c
End Sub
（mm） 2019/03/05(火) 18:13

ｂｉさま、関数とマクロ？コード？ありがとうございます。
時間がかかりましたが、何とか思った表にたどり着けました。

mmさまもありがとうございます。
一回で表が作成されて感動しました！
一点教えていただきたいのですが、表を作成すると商品名と材料名も一緒に作成されるのですが
商品名と材料名を除いた表にすることはできますか？

とっても簡単にできる様になったので、このままでも全然大丈夫です。
もし、除けそうであればお願いいたします。
（初心者） 2019/03/06(水) 10:31

Sub main()

 '元データはSheet1にある前提
    Dim ast As Worksheet, sht As Worksheet, dic As Object, c As Range, i As Long
    Set ast = Sheets("Sheet1")
    For Each sht In Worksheets
        If sht.Name = "商品ごと" Or sht.Name = "材料ごと" Then Application.DisplayAlerts = False: sht.Delete
    Next sht
    Set dic = CreateObject("Scripting.Dictionary")
    Sheets.Add after:=ast
    ActiveSheet.Name = "商品ごと"
    Sheets.Add after:=ast
    ActiveSheet.Name = "材料ごと"
    For Each c In ast.Range("A1:A" & Rows.Count).SpecialCells(2)
        Sheets("商品ごと").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = c.Value
        For i = 0 To UBound(Split(c.Offset(, 10).Value, "、"))
            dic(Split(c.Offset(, 10).Value, "、")(i) & Chr(2) & c.Value) = True
            If Sheets("材料ごと").Range("A:A").Find(Split(c.Offset(, 10).Value, "、")(i), , , xlWhole) Is Nothing Then
                Sheets("材料ごと").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Split(c.Offset(, 10).Value, "、")(i)
            End If
        Next i
    Next c
    With Sheets("材料ごと").Sort
        .SortFields.Add Key:=Sheets("材料ごと").Range("A1")
        .SetRange Sheets("材料ごと").Range("A2:A" & Rows.Count)
        .Apply
    End With
    With Sheets("商品ごと").Sort
        .SortFields.Add Key:=Sheets("商品ごと").Range("A1")
        .SetRange Sheets("商品ごと").Range("A2:A" & Rows.Count)
        .Apply
    End With
    Sheets("材料ごと").Range("A:A").SpecialCells(2).Copy
    Sheets("商品ごと").Range("B1").PasteSpecial , Transpose:=True
    Sheets("商品ごと").Range("A:A").SpecialCells(2).Copy
    Sheets("材料ごと").Range("B1").PasteSpecial , Transpose:=True
    For Each c In Sheets("材料ごと").Range("A1").CurrentRegion.SpecialCells(4)
        If dic(c.EntireRow.Cells(1) & Chr(2) & c.EntireColumn.Cells(1)) = True Then c.Value = "○"
    Next c
    For Each c In Sheets("商品ごと").Range("A1").CurrentRegion.SpecialCells(4)
        If dic(c.EntireColumn.Cells(1) & Chr(2) & c.EntireRow.Cells(1)) = True Then c.Value = "○"
    Next c

    Sheets("商品ごと").Rows(1).ClearContents '追加
    Sheets("商品ごと").Columns(1).ClearContents '追加
    Sheets("材料ごと").Rows(1).ClearContents '追加
    Sheets("材料ごと").Columns(1).ClearContents '追加

End Sub
（mm） 2019/03/06(水) 11:06

mmさま、何度もありがとうございます。
先ほど掲載いただきました追加行について
すいません、説明が悪くて誤解させてしまいました。
最初に教えて頂いたコードで表を作成すると最終列と最終行に
商品名と材料の列と行が作成されてしまいます。
商品名と材料はそれぞれのタイトルになりますので除くことは
出来ないでしょうか？
とお聞きしたかったのです。
申し訳ありませんでした。
（初心者） 2019/03/06(水) 12:24

最初に教えて頂いたコードで表を作成すると最終列と最終行に
商品名と材料の列と行が作成されてしまいます。

→　こちらの環境(2007)では再現しませんので対応できません。すみません。
（mm） 2019/03/06(水) 13:15

あまり詳しく無いのですが。。。
2007で試したところこの様になりました。
(中身の◯は省いてます。)

 シート名:sheet1				
 	A　　　　　　　K		
 1　　商品名　 　　　 材料		
 2　 目玉焼き　　　22卵、92塩		
 3　　アイス　　 　23牛乳、21砂糖		
 4　カップケーキ　 01小麦粉、21砂糖、31バター		
 シート名:商品ごと							
 	A　　　　　B　　　　　C　　　　　D　　　　　Ｅ　　　　
 1　　        01小麦粉　　21砂糖　　　22卵       材料
 2　　アイス
 3　カップケーキ
 4　 目玉焼き
 5     商品名                                  ◯
 シート名:材料ごと				
 	A　　　　B　　　　　　C　　　　　　D　　　　　Ｅ
 1　             アイス　　カップケーキ　　目玉焼き     商品名
 2　 01小麦粉
 3　 21砂糖
 4　　22卵
 5    材料                                     ◯

恐らく
For Each c In ast.Range("A1:A" & Rows.Count).SpecialCells(2)
の部分を
For Each c In ast.Range("A2:A" & Rows.Count).SpecialCells(2)
にすればうまく行くと思うのですが如何でしょうか？
（みろく） 2019/03/06(水) 20:30

コメント返信：

[ 一覧(最新更新順) ]

[[20190305120757]] 『表の作成方法』（初心者） ページの最後に飛ぶ

[[20190305120757]]　『表の作成方法』（初心者）　ページの最後に飛ぶ