[[20110713165112]]　『別シートの来場者リストを自動で表示したい』（ラディック）　ページの最後に飛ぶ

『別シートの来場者リストを自動で表示したい』（ラディック）

 Excel2000  WindowsXP

 先日『名前の頭文字だけ抽出して置き換えたい』でお世話になったものですが、追加で質問です。

 シート１に

     E列　　F列　　　　G列　　H列
 6   行　　名前　　　　枚数　取得者
 7   ア　　アイカワ　　1枚　 省略　
 8　 サ　　スズキ　　　1枚
 9　 ア　　ウエノ　　　2枚
 10　サ　　スドウ　　　1枚
 11　ア　　イイダ　　　1枚
 12　カ　　クワタ　　　3枚
 13　カ　　カガワ　　　1枚
 14　ア　　オオタ　　　1枚

のように、F列には名前　E列には名前の頭文字を「アカサタナ」に変換したもの（関数で表示）G列にはチケットの枚数、H列には予約を取った取得者（身内）が記入されていて、

 これをシート２に

  　　A列　　　 B列　　C列　 D列　　　 E列

 3　　ア行　　　枚数　　　　 カ行　　  枚数　　　　　　　
 4　　アイカワ　1枚          カガワ　　1枚
 5　　イイダ　　1枚　　　　　クワタ　　3枚
 6　　ウエノ　　2枚
 7　　オオタ　　1枚
 8 
 9 
 10　 サ行　　　枚数　　　　 タ行
 11 　スズキ　　1枚　　　　　同様に…
 12 　スドウ　　1枚

 と言う感じで、シート１にリストが追加されたら、シート２に自動で表示されるようにしたいのですが、可能でしょうか？

 欲を言えば自動で五十音順で並び替えまで出来ると最高ですが、出来なければ並び替え位はマクロ組んでやります。

 よろしくお願いします！

 数式レベルだと大変そうに見えます。
 >出来なければ並び替え位はマクロ組んでやります。
 が可能のであれば、全体をマクロで処理することを検討してはどうでしょうか。
 　1)シート1をシート2にコピー
 　2)シート2をソート
 　3)アカサタナ順でレイアウト調整
 とすれば10～20行くらいの処理だと思いますが。
 (Mook)

やはりすべてをマクロで組むしかないですか…
がんばってやってみます！

 ピボットテーブルで
 行フィールドに行と名前、列とデータフィールドに枚数
 を入れてあげれば、ほとんど近くないですか？
 ソートもされますし
 （ｍｏｍｏ）

ピボットテーブルも試してみたんですが、印刷して提出するので、あくまで上記の表の形じゃないといけないんです。。。（ラディック）

 ごめんなさい。
 やってみましたが20行では書けませんでした。

 かなり無理して26行でしたが、本来は40行くらいはかかりますね。
 Sub Sample26()
    Worksheets(1).Range("E1").End(xlDown).CurrentRegion.Copy
    With Worksheets(2)
        .Range("A1").PasteSpecial xlPasteValues
        .Columns("A:D").Sort key1:=.Range("B1"), Order1:=xlAscending
        Const aks = "アカサタナハマヤラワヲン"
        Dim i, j, r, dr(2)
        r = 1: dr(0) = 1: dr(1) = 1
        For i = 2 To Len(aks) Step 2
            For j = 0 To 1
                .Cells(dr(j), 5 + 3 * j).Resize(1, 2).Value = Array(Mid(aks, i - 1 + j, 1) & "行", "枚数")
                If .Cells(r, "A").Value <> "" Then
                    Do While AscW(.Cells(r, "A").Value) < AscW(Mid(aks, i + j, 1))
                        dr(j) = dr(j) + 1
                         .Cells(dr(j), 5 + 3 * j).Resize(1, 2).Value = .Cells(r, "B").Resize(1, 2).Value
                         r = r + 1
                        If .Cells(r, "A").Value = "" Then Exit Do
                    Loop
                End If
            Next
            If dr(0) < dr(1) Then dr(0) = dr(1)
            dr(0) = dr(0) + 2: dr(1) = dr(0)
        Next
        .Columns("A:D").Delete
    End With
 End Sub
 (Mook)

 フィルターオプションを使った別案

 Sub Sample()
    Dim myA As Range, myW As Range
    Dim w1 As Variant, w2 As Variant
    Dim z As Long, z1 As Long, z2 As Long
    Dim j As Long

    With Sheets("Sheet1")
        Set myA = .Range("E6", .Range("E" & .Rows.Count).End(xlUp)).Resize(, 3)
        Set myW = .Cells(1, myA.Cells(myA.Count).Column + 2).Resize(2)
        myW(1).Value = "行"
    End With

    With Sheets("Sheet2")
        .Cells.ClearContents
        For Each w1 In Array("アカ", "サタ", "ナハ", "マヤ", "ラワ")
            z1 = .Range("A" & .Rows.Count).End(xlUp).Row
            z2 = .Range("D" & .Rows.Count).End(xlUp).Row
            z = WorksheetFunction.Max(z1, z2) + 2
            j = -2
            For Each w2 In Array(Left(w1, 1), Right(w1, 1))
                j = j + 3
                .Cells(z, j).Resize(, 2).Value = Array("名前", "枚数")
                myW(2).Value = w2
                myA.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myW, _
                        CopyToRange:=.Cells(z, j).Resize(, 2), Unique:=False
                .Cells(z, j).Value = w2 & "行"
            Next
        Next
    End With

    myW.ClearContents
    Set myA = Nothing
    Set myW = Nothing

 End Sub

 ぶらっと立ち寄り

 ありがとうございます。
 しかし、お二方のを試しみましたが、どうも上手く行きません・・・
 原因はおそらくレイアウトが若干変わったのと、説明不足もあったんですがシート２は印刷用なのでフォーマットのような感じで、消えてはいけない文字（見出しや会場名など）があったり、逆にシート１からは引用したくない部分（取得者など）があるんです。
 なので、元になる数式やVBAをいただいて、対応するセルだけ変えればいいかな？とか思ってたんですが、甘かったですね。自分には早すぎる技術でした（´д｀）
 もう少し勉強してから出直します。

 考えて下さってありがとうございました！
 そしてごめんなさい。。。(ラディック)

コメント返信：

[ 一覧(最新更新順) ]

[[20110713165112]] 『別シートの来場者リストを自動で表示したい』（ラディック） ページの最後に飛ぶ

[[20110713165112]]　『別シートの来場者リストを自動で表示したい』（ラディック）　ページの最後に飛ぶ