[[20190216213959]]　『リスト表からマトリクス表の作成マクロについて』（マリリ）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『リスト表からマトリクス表の作成マクロについて』（マリリ）

 下記のSheet'リスト'からSheet'関東'のような表をマクロで作りたいのですが、教えていただけないでしょうか。宜しくお願いします。

 Sheetリスト
  　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ　　Ｇ　　Ｈ
 1
 2
 3 　　　　　　　番号　 名称１  名称２   単位　数量　分類
 4　　　　　　　２００　 東京　 バナナ　　本　　２　 関東
 5　　　　　　　２１０　 東京　 ごぼう　　本　 ２０　関東
 6　　　　　　　２２０　神奈川　バナナ　　本　　２　 関東
 7　　　　　　　２５０　 京都　グローブ　 個　 ３９　関西
 8　　　　　　　３００　 大阪　 ボール　　個　　２　 関西
 9　　　　　　　３００　神奈川　バナナ　　本　　５　 関東
 10 　　　　　　３５０　 福岡　 みかん　　個　　７　 九州
 11 　　　　　　４００　 東京　 バナナ　　本　　５　 関東
 12 　　　　　　４００　 大阪 ゴムボール　個　　１　 関西

 Sheet関東 
 　　Ａ　 Ｂ　　　Ｃ　　Ｄ　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ
 1
 2
 3
 4　　　　　　　　　　２００　２１０　２２０　３００　４００
 5　　　 東京
 6　　　バナナ　　本　　２　　　　　　　　　　　　　　　５
 7　　　 東京
 8　　　ごぼう　　本　　　　　 ２０
 9　　　神奈川
 10　　 バナナ　　本　　　　　　　　　　２　　　５

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

---

 若干異なりますが、ピボットテーブルではダメですか？
（稲葉） 2019/02/17(日) 05:18

---

 頭まわらんけど、一応
 思ったより面倒ですね。
 もっとスマートな書き方あると思います。
 ピボットテーブル勧めます。

    Option Explicit
    Sub ピボット()
        Dim dic As Object
        Dim w As Variant
        Dim 分類 As String, 名称 As String, 番号 As String
        Dim k分類 As Variant, k名称 As Variant, k番号 As Variant, k数量 As Variant
        Dim i As Long, n As Long, m As Long
        Dim ans As Variant
        Set dic = CreateObject("Scripting.Dictionary")
        w = Sheets("Sheet1").Range("H3", Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp)).Value
        For i = 2 To UBound(w, 1)
            分類 = w(i, 6): 名称 = w(i, 2) & "_" & w(i, 3): 番号 = w(i, 1)
            If Not dic.exists(分類) Then Set dic(分類) = CreateObject("Scripting.Dictionary")
            If Not dic(分類).exists(名称) Then Set dic(分類)(名称) = CreateObject("Scripting.Dictionary")
            dic(分類)(名称)(番号) = dic(分類)(名称)(番号) + w(i, 5)
        Next i
        For Each k分類 In dic.keys
            n = 1: m = 2
            ReDim ans(1 To n, 1 To m)
            For Each k名称 In dic(k分類).keys
                n = n + 2
                ans = Application.Transpose(ans)
                ReDim Preserve ans(1 To m, 1 To n)
                ans = Application.Transpose(ans)
                For Each k番号 In dic(k分類)(k名称).keys
                    m = m + 1
                    ReDim Preserve ans(1 To n, 1 To m)
                    ans(1, m) = k番号
                    ans(n - 1, 1) = Split(k名称, "_")(0)
                    ans(n, 1) = Split(k名称, "_")(1)
                    ans(n, 2) = Application.Evaluate("=VLOOKUP(""" & ans(n, 1) & """,Sheet1!E:F,2,0)")
                    ans(n, m) = dic(k分類)(k名称)(k番号)
                Next k番号
            Next k名称
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = k分類
            With Sheets(k分類)
                .Range("B4").Resize(UBound(ans, 2), UBound(ans, 1)).Value = Application.Transpose(ans)
                .Range(.Range("B6").Resize(, UBound(ans, 2)), .Cells(Rows.Count, "B").End(xlUp)).Sort key1:=.Range("B6"), Header:=xlNo
                ans = .Range("B4").Resize(UBound(ans, 2), UBound(ans, 1)).Value
                .Cells.ClearContents
                .Range("B4").Resize(UBound(ans, 2), UBound(ans, 1)).Value = Application.Transpose(ans)
            End With
        Next k分類
    End Sub
（稲葉） 2019/02/17(日) 07:27

---

 おはようございます。

 一晩寝たら胸のカラータイマーがビンビンです。(嘘です。見栄はりました。弱弱しいです。(笑)

 最近、体力がなくてね。。。。年だね。。。

 ところで↓みたいになりましたけど、、、答えはあってますかぁ？？？

 では、、では、、

 関東
		       200	210	220	300	400
 東京						
 バナナ	       本	2				5
 東京						
 ごぼう	       本		20			
 神奈川						
 バナナ	       本			2	5	

 関西
		         250	300	400
 京都				
 グローブ	個	39		
 大阪				
 ボール 　	個		 2	
 大阪				
 ゴムボール	個			1

 九州
		        350
 福岡		
 みかん	        個	7

 Option Explicit
Sub 改造てすと()
Dim MyTbl As Range
Dim MyA As Variant
Dim MyB As Variant
Dim MyC As Variant
Dim MyAry() As Variant
Dim MyDic As Object
Dim MyScaA As Object
Dim MyScaB As Object
Dim MyScaC As Object
Dim MyScaD As Object
Dim MyKey As Variant
Dim 項目 As Variant
Dim ws As Worksheet
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim w As Variant
Dim q As Variant
Dim i As Long
Dim j As Long
Dim ii As Long
Dim k As Long
Dim n As Long
Dim MyTimer As Single
MyTimer = Timer
Set MyDic = CreateObject("Scripting.Dictionary")
Set MyScaA = CreateObject("System.Collections.ArrayList")
Set MyScaB = CreateObject("System.Collections.ArrayList")
Set MyScaC = CreateObject("System.Collections.ArrayList")
With Sheets("リスト")
    Set MyTbl = .Range("C3", .Range("C" & Rows.Count).End(xlUp)).Resize(, 6)
    MyA = MyTbl.Value
    MyB = Intersect(.Range("C:F"), MyTbl).Value
    MyC = Intersect(.Range("D:F"), MyTbl).Value
End With
For i = LBound(MyA, 1) + 1 To UBound(MyA, 1)
    If Not MyScaB.Contains(MyA(i, 6)) Then
        MyScaB.Add MyA(i, 6)
        If Not Evaluate("=ISREF('" & MyA(i, 6) & "'!A1)") Then Sheets.Add.Name = MyA(i, 6)
    End If
Next
w = MyScaB.ToArray
For ii = LBound(w) To UBound(w)
    For i = LBound(MyA, 1) + 1 To UBound(MyA, 1)
        If w(ii) = MyA(i, 6) Then
            MyKey = Replace(Join(Application.Index(MyB, i, 0)), " ", "")
            MyDic(MyKey) = MyDic(MyKey) + Val(MyA(i, 5))
            If Not MyScaA.Contains(MyA(i, 1)) Then MyScaA.Add MyA(i, 1)
            項目 = Join(Application.Index(MyC, i, 0))
            If Not MyScaC.Contains(項目) Then MyScaC.Add 項目
        End If
    Next
    x = MyDic.keys
    y = MyDic.items
    MyScaA.Sort
    z = MyScaA.ToArray
    q = MyScaC.ToArray
    k = 1
    ReDim MyAry(1 To (UBound(q) + 1) * 2 + 1, 1 To UBound(z) + 3)
    For j = LBound(MyAry, 2) + 2 To UBound(MyAry, 2)
        MyAry(k, j) = z(j - 3)
    Next
    For n = LBound(q) To UBound(q)
        k = k + 2
        MyAry(k - 1, 1) = Split(q(n))(0)
        MyAry(k, 1) = Split(q(n))(1)
        MyAry(k, 2) = Split(q(n))(2)
        For j = LBound(z) To UBound(z)
            MyKey = z(j) & Split(q(n))(0) & Split(q(n))(1) & Split(q(n))(2)
            MyAry(k, j + 3) = MyDic(MyKey)
        Next
    Next
    With Sheets(w(ii))
        .Cells.Clear
        .Range("B4").Resize(UBound(MyAry, 1), UBound(MyAry, 2)).Value = MyAry
        .Range("B4").CurrentRegion.EntireColumn.AutoFit
    End With
    MyDic.RemoveAll
    MyScaA.Clear
    MyScaC.Clear
Next
Set MyTbl = Nothing
Set MyDic = Nothing
Set MyScaA = Nothing
Set MyScaB = Nothing
Set MyScaC = Nothing
Erase MyA, MyB, MyC, MyAry, x, y, z, w, q
MyTimer = Timer - MyTimer
MsgBox "完了!!!　" & Format(MyTimer, "###0.000") & "秒"
End Sub
seiya さんのを参考にちょっと修正(^^;
（SoulMan） 2019/02/17(日) 07:34

---

 おはようござぁ〜す。＾＾
検証マン発表！
SoulMan様のコードは正常に作動致しており
フイルターで視認した範囲で結果も合っていると
思います。
(#^.^#)お二方ともさえておられますね。。。
隠居じーさんは今も思案中　(￣▽￣；)。。。いかん　←　年のせいにしてますが。。。実はわかってない
（隠居じーさん） 2019/02/17(日) 08:34

---

 おはようございます。いつもありがとうございます。

 昨夜は、諸事情(馬券外れ）からの体調不良で失神していました。(笑)

 今日も、張り切って行きましょう！！！

 P.S今日は、絶対に当てなあかん！！！！！
（SoulMan） 2019/02/17(日) 08:41

---

 ありゃ
 私のは合ってなかったですか？
 今日はこれから子守りなので、続きは隠居じーさんさんにお願いします！！
（稲葉） 2019/02/17(日) 08:56

---

 おはようございます。＾＾；稲葉さま
申し上げづらいのですが。。。
私のテスト環境では
関東の神奈川バナナの表示位置
関西の大阪ゴムボール。。。
などがすこぉ〜し違うのでは
と思うのですが、何分、トピ主様の情報が解りませんので
一概には申し上げられないと。。。おもい、コメントは差し控えておりました。
あくまで、私のテスト環境での事で御座いますので。
お聞き流しくださりませ。
続きが出来るほどスキルもございませんで。。。恐れ多い事でございます。
完成させる事が出来ましたら（？ですが）アップ致しますので、ご批評など
賜れば幸甚で御座います
m(__)m
でわ

（隠居じーさん） 2019/02/17(日) 09:31

---

 ようやく質問を理解できた...

 Sub test()
     Dim a, e, s, v, i As Long, ii As Long, n As Long, t As Long
     Dim dic As Object, AL As Object, txt As String
     Set dic = CreateObject("Scripting.Dictionary")
     Set AL = CreateObject("System.Collections.ArrayList")
     a = Sheets("リスト").[c3].CurrentRegion.Value
     For i = 2 To UBound(a, 1)
         If Not AL.Contains(a(i, 1)) Then AL.Add a(i, 1)
         If Not dic.exists(a(i, 6)) Then
             Set dic(a(i, 6)) = CreateObject("Scripting.Dictionary")
         End If
         txt = Join(Array(a(i, 2), a(i, 3), a(i, 4)), Chr(2))
         If Not dic(a(i, 6)).exists(txt) Then
             Set dic(a(i, 6))(txt) = CreateObject("Scripting.Dictionary")
         End If
         dic(a(i, 6))(txt)(a(i, 1)) = dic(a(i, 6))(txt)(a(i, 1)) + a(i, 5)
     Next
     AL.Sort
     For Each e In dic
         If Not Evaluate("isref('" & e & "'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = e
         ReDim a(1 To dic(e).Count * 2 + 1, 1 To AL.Count + 2): n = 1
         With Sheets(e).Range("b3")
             With .CurrentRegion
                 .ClearContents
                 .Borders.LineStyle = xlNone
             End With
             t = 2: n = 1
             For ii = 0 To AL.Count - 1
                 For i = 0 To dic(e).Count - 1
                     If dic(e).items()(i).exists(AL(ii)) Then
                         t = t + 1: a(1, t) = AL(ii): Exit For
                     End If
                 Next
             Next
             For Each s In dic(e)
                 n = n + 1: a(n, 1) = Split(s, Chr(2))(0)
                 n = n + 1: a(n, 1) = Split(s, Chr(2))(1)
                 a(n, 2) = Split(s, Chr(2))(2)
                 For ii = 3 To t
                     If dic(e)(s).exists(a(1, ii)) Then a(n, ii) = dic(e)(s)(a(1, ii))
                 Next
             Next
             With .Resize(n, t)
                 .Value = a
                 .Borders.Weight = 2
             End With
         End With
     Next
 End Sub
（seiya） 2019/02/17(日) 14:24

---

稲葉 様

 SoulMan 様
 seiya 様

 皆様ありがとうございます。

 SoulMan 様の .ArrayList の部分でオートメーションエラー というのが出ましたが
 「Windows機能の有効化または無効化」の「.Net Framework 3.5の有効化」を行うことでエラー回避できました。ありがとうございます。

 seiya 様、ファイルまでありがとうございます。問題なく動作できました。

 稲葉 様のを動作させると 隠居じーさん 様 のおっしゃる通り一部異なる部分ができてしまいました。

 ＞＞稲葉 様
 ＞＞若干異なりますが、ピボットテーブルではダメですか？

 ピボットでも同じようなことできるんですね（汗 
 恥ずかしながら知りませんでした（汗
 勉強いたします。

 皆様からの回答のおかげで希望通りできそうです。
 ありがとうございました。
（マリリ） 2019/02/17(日) 15:07

---

 あ、お返事いただいてから恐縮ですが、先ほどコード入れ替えいたしました。
 15:12より前にコードをコピーされた場合は、今一度全文入れ替えていただけると助かります。

 最後のソート部分で、範囲指定を誤っていました。申し訳ございません。

 隠居じーさんさんありがとうございました。
（稲葉） 2019/02/17(日) 15:14

---

 いえいえ
恐縮で御座います。
m(_ _)m

（隠居じーさん） 2019/02/17(日) 15:19

---

 ちなみに、ピボットテーブルの場合の配置例
    |[A]        |[B]   |[C] |[D]     |[E]|[F]|[G]|[H]|[I] 
 [1]|分類       |関東  |    |        |   |   |   |   |    
 [2]|           |      |    |        |   |   |   |   |    
 [3]|合計 / 数量|      |    |列ラベル|   |   |   |   |    
 [4]|行ラベル   |名称２|単位|     200|210|220|300|400|総計
 [5]|神奈川     |バナナ|本  |        |   |  2|  5|   |   7
 [6]|東京       |ごぼう|本  |        | 20|   |   |   |  20
 [7]|           |バナナ|本  |       2|   |   |   |  5|   7
 [8]|総計       |      |    |       2| 20|  2|  5|  5|  34

 手順は
 １）Sheet1のC3:H12を範囲選択する
 ２）挿入＞ピボットテーブル＞新規シート
 ３）列ラベルに「番号」　
 　　行ラベルに「名称１」「名称２」「単位」
 　　値に「数量」
 　　レポートフィルタに「分類」
 ４）３）で配置した「名称１」の▼をクリック→フィールドの設定
 　　[レイアウトと印刷]タブ　[○アイテムのラベルを表形式で表示する] にチェック
 ５）「名称２」も４）の手順を行う
 ６）B2セルのコンボボックスから「関東」を選択

 これで、B2のコンボボックスを選択することで、分類を切り替えて表示できます。

 こうしておけば、行ラベルから名称１または名称２を入れ替えるだけで、
 集計項目を変更できるので便利です。

 ご参考になれば幸いです。
 ちなみに、元の表が良い形に出来上がっていたので使えました。
（稲葉） 2019/02/17(日) 15:30

---

 やっとできました　＾＾　もうすでに終了ですね。。。(￣▽￣)。。。m(_ _)m
AdvancedFilter使用

 Option Explicit
Sub main()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim y As Long
    Dim No()
    Dim Ac()
    Dim rr As Range
    Dim sr As Range
    Dim r As Range
    Dim retu
    Dim cnt
    Ws_Delete_M
    Set s1 = Worksheets("リスト")
    Set rr = s1.Range("C3").CurrentRegion
    No = Master_Maker(rr.Columns(6), s1)
    For cnt = 0 To UBound(No)
        s1.Copy before:=Worksheets(1)
        Set s2 = ActiveSheet
        With s2
            .Range("J1") = "分類"
            .Range("J2") = No(cnt)
            'Filter
            '.Range("M:R").Clear
            rr.AdvancedFilter xlFilterCopy, .Range("J1").CurrentRegion, .Range("M1"), False
            .Range("A:L").Delete
            Set r = .Range("A1").CurrentRegion
            For i = 1 To r.Rows.Count
                .Cells(i, 10) = r(i, 2) & Chr(29) & r(i, 3)
            Next
            Ac = Master_Maker(.Range("J1").CurrentRegion, s2)
            .Range("J1").CurrentRegion.Clear
            r.Columns(1).Copy .Range("H1")
            .Range("H1").Sort key1:=.Range("H1"), Header:=xlYes
            .Range("l2").Resize(, .Range("H1").CurrentRegion.Rows.Count) = _
            WorksheetFunction.Transpose(.Range("H1").CurrentRegion)
            .Range("G:L").Clear: y = 3
            For i = 0 To UBound(Ac)
                .Cells(y, 11) = Split(Ac(i), Chr(29))(0)
                .Cells(y, 11).Offset(1) = Split(Ac(i), Chr(29))(1)
                For j = 2 To r.Rows.Count
                    If (Split(Ac(i), Chr(29))(0) = r(j, 2)) * (Split(Ac(i), Chr(29))(1) = r(j, 3)) Then
                        Set sr = .Range(.Cells(2, 13), .Cells(2, .Cells(2, .Columns.Count).End(xlToLeft).Column))
                        retu = WorksheetFunction.Match(r(j, 1).Value, sr, 0)
                        retu = retu + 12
                        .Cells(y, 12).Offset(1) = r(j, 4)
                        .Cells(y, retu).Offset(1) = r(j, 5)
                    End If
                Next
                y = y + 2
            Next
            .Range("A:I").Delete
            s2.Name = No(cnt)
        End With
    Next
End Sub
Private Function Master_Maker(target As Range, ws As Worksheet) As Variant
    Dim tmp()
    Dim r
    Dim i As Long
    With ws
    target.AdvancedFilter xlFilterCopy, , .Range("M1"), True
    Set r = .Range("M1").CurrentRegion
         For i = 2 To r.Rows.Count
             ReDim Preserve tmp(i - 2)
            tmp(i - 2) = r(i, 1).Value
        Next
        .Range("M1").CurrentRegion.Clear
    End With
    Master_Maker = tmp
End Function
（隠居じーさん） 2019/02/18(月) 19:15

---

 お、私もAdvancedFilterで2案目に作っておいたので、答え合わせ！
    Option Explicit
    Sub 振替2()
        Dim wsCri As Worksheet, wsLst As Worksheet
        Dim r1 As Range, r2 As Range
        Dim mr As Long
        Dim n As Long
        Dim f As String
        Set wsLst = Sheets("Sheet1")
        Set wsCri = Sheets.Add(after:=Sheets(Sheets.Count))
        wsCri.Range("A1:F1").Value = [{"分類","分類","番号","名称１","名称２","単位"}]
        '名前付き引数説明               AdvancedFilter Action      , CriteriaRange       , CopyToRange      , Unique
        wsLst.Range("C3").CurrentRegion.AdvancedFilter xlFilterCopy, wsCri.Range("A1:A2"), wsCri.Range("A1"), True '重複のない分類を取得
        For Each r1 In wsCri.Range("A2", wsCri.Cells(Rows.Count, "A").End(xlUp))
            wsCri.Range("B2").Value = r1.Value
            With wsLst.Range("C3").CurrentRegion
                .AdvancedFilter xlFilterCopy, wsCri.Range("B1:B2"), wsCri.Range("C1"), True                        '重複のない分類別番号を取得
                .AdvancedFilter xlFilterCopy, wsCri.Range("B1:B2"), wsCri.Range("D1:F1"), True                     '重複のない名称１名称２単位を取得
            End With
            If Evaluate("=ISERROR(" & r1.Value & "!A1)") Then Sheets.Add after:=Sheets(Sheets.Count): Sheets(Sheets.Count).Name = r1.Value
            mr = wsCri.Cells(Rows.Count, "C").End(xlUp).Row                                                        '番号の最大行数
            With Sheets(r1.Value)
                .Cells.ClearContents
                .Range("D4").Resize(, mr - 1).Value = Application.Transpose(wsCri.Range("C2:C" & mr).Value)        'D4から番号を入れる
                n = 4 'B4セル
                For Each r2 In wsCri.Range("D2", wsCri.Cells(Rows.Count, "D").End(xlUp))
                    n = n + 1
                    .Cells(n, "B") = r2.Value
                    n = n + 1
                    .Cells(n, "B") = r2.Offset(, 1).Value
                    .Cells(n, "C") = r2.Offset(, 2).Value
                    'Evaluate　Ver.
                    'f = "=IF(COLUMN(" & Range("A1").Resize(, mr - 1).Address & "),SUMIFS(" & wsLst.Name & "!G:G,"
                    'f = f & wsLst.Name & "!C:C," & r1.Value & "!" & Range("D4").Resize(, mr - 1).Address & ","
                    'f = f & wsLst.Name & "!D:D," & r1.Value & "!" & "B" & n - 1 & ","
                    'f = f & wsLst.Name & "!E:E," & r1.Value & "!" & "B" & n & "))"
                    '.Cells(n, "D").Resize(, mr - 1).Value = Evaluate(f)
                    '
                    '計算式Ver.
                    .Cells(n, "D").Resize(, mr - 1).Formula = "=SUMIFS(" & wsLst.Name & "!$G:$G," & wsLst.Name & "!$C:$C,D4," & wsLst.Name & "!$D:$D,$B" & n - 1 & "," & wsLst.Name & "!$E:$E,$B" & n & ")"
                Next r2
            End With
        Next r1
        Application.DisplayAlerts = False
        wsCri.Delete
        Application.DisplayAlerts = True
    End Sub
（稲葉） 2019/02/18(月) 19:26

---

 おお！すごいですね。。。さすがですね。＾＾ｖ
計算式埋め込みバージョンですね。
勉強させて戴きます。。。。
有難うございました。
m(_ _)m
（隠居じーさん） 2019/02/18(月) 19:54

---

Sub main()

    Dim dic As Object, c As Range, i As Long, j As Long, lett As String
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("関東")
        .Cells.ClearContents
        For Each c In Sheets("リスト").Range("H:H").SpecialCells(2)
            If c.Value = "関東" Then
                If WorksheetFunction.CountIf(.Rows(4), c.Offset(, -5).Value) = 0 Then
                    .Cells(4, j + 4).Value = c.Offset(, -5).Value: j = j + 1
                End If
                lett = c.Offset(, -4).Value & "|" & c.Offset(, -3).Value
                If Val(dic(lett)) = 0 Then
                    .Cells(i + 5, 2).Value = c.Offset(, -4).Value & "|" & c.Offset(, -3).Value
                    .Cells(i + 6, j + 3).Value = c.Offset(, -1).Value
                    .Cells(i + 6, 3).Value = c.Offset(, -2).Value
                    dic(lett) = i + 5
                    i = i + 2
                Else
                    .Cells(dic(lett), 2).Value = c.Offset(, -4).Value & "|" & c.Offset(, -3).Value
                    .Cells(1 + dic(lett), j + 3).Value = c.Offset(, -1).Value
                    .Cells(1 + dic(lett), 3).Value = c.Offset(, -2).Value
                End If
            End If
        Next c
        For Each c In .Range("B:B").SpecialCells(2)
            If InStr(c.Value, "|") > 0 Then
                c.Offset(1).Value = Split(c.Value, "|")(1)
                c.Value = Split(c.Value, "|")(0)
            End If
        Next c
    End With
End Sub
（mm） 2019/02/21(木) 18:10

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.