[[20210312211707]]　『マクロを利用して別のシートと同じ順に並び替えた』（リース）　ページの最後に飛ぶ

『マクロを利用して別のシートと同じ順に並び替えたい』（リース）

シート１には名簿、シート２以降には各人がそれぞれ入力する共有の管理ファイルを作成したいと思っています。
シート１とシート２は連動していて、シート１の並び替えを行った場合、シート２も同じ並びに代わるようなエクセルを作りたいのですが、どうかお力添え願えないでしょうか。

イメージとしては以下の通りです。

シート１に「管理番号」「氏名」「グループ名」などの属性を持つ

1234 田中太郎　グループ１
9999 山田花子　グループ２
5678 高橋次郎　グループ２

といった表を入力して管理したいです。（実際にはもっと右に続きます）

シート２以降には

　　　　　　　　１　２　３　４　５　
1234 田中太郎　　〇　　　　　△
9999 山田花子　　　　△　〇
5678 高橋次郎　　×　×　　　　　〇

といったように、各利用者が自分の名前の行に自分のステータスを入力するシートにしたいと思っています。

これを、シート１でフィルターを利用して「管理番号」をキーに昇順に並べ替え、

1234 田中太郎　グループ１
5678 高橋次郎　グループ２
9999 山田花子　グループ２

としたときに、シート２以降が

　　　　　　　　１　２　３　４　５　
1234 田中太郎　　〇　　　　　△
5678 高橋次郎　　×　×　　　　　〇
9999 山田花子　　　　△　〇

と自動で並び変わるようにしたいのですが、どうしたらうまくいくでしょうか。（並び替えた後「適用」ボタンを押すとシート２に反映されるイメージ）
実際にはもっと複雑な並び替えを反映させたり、拡張性を持たせたいです。

名簿を管理する人はシート１だけを、各利用者はステータス（〇や△）だけを入力するようにしたいので、シート２でも並び替えを使う…といったことは避けたいです。

またシート２と同じようなシート３も用意し、そちらも同じように連動させたいです。

当方エクセル初心者ですが、各利用者はさらに得意でない方もいらっしゃるため、どうかご理解お願いします。

一応関数を使って色々試してみたのですがうまくいかず、作ったことのないマクロを使用しないと実現できないと感じたので投稿いたします。
どなたかご教示の程お願い致します。

追記：

シート１に作った表に新たに人を追加する場合も考慮したいです。増やした場合はステータス欄は全てブランクで表示したいです。

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

＞と自動で並び変わるようにしたいのですが
シート１で昇順に並べ替えたものをそのまま転記するということだろうか。
（MA） 2021/03/12(金) 22:51

 こんばんは！
管理番号があるのですからシート1がマスターとして
シート2に仮のデーターを作成しておいて
シート3でVlookupで管理番号をキーに検索すればいいのではないでしょうか？？？
と思いますが、、どうでしょう？
（SoulMan） 2021/03/12(金) 22:53

＞MAさん

そうですね。結果的に入力してもらったステータスとズレなければ、方法はなんでも良いです。
私の浅知恵では、INDIRECT関数かVLOOKUP関数と併用するのかな、とおもっていました

＞SoulManさん

すみません、良く分かりません…
「検索」の話がシート３で何か操作する（フィルター、並べ替え）のであればそれは避けたいのです。

（リース） 2021/03/12(金) 23:17

 シート2をいきなりシート1と同じように並び替えようとするから難しいのであって
シート2は仮に作っておいて
シート3でシート1の管理番号をキーにシート2の内容を検索すればいいのでは？
わかりますぅ？？？
（SoulMan） 2021/03/12(金) 23:52

私もそれを試しましたが、検索結果通りの順に〇や△のステータスを入力した行を移動させる方法が分かりませんでした。（管理番号と名前は同じ場所に移動するが、ステータス欄はそのまま）
そもそも直接入力してもらうセルであるため関数を利用できず、これは関数では解決できないと思って質問させていただきました。
（リース） 2021/03/13(土) 00:45

 vlookupでシート1の並びで
シート2を検索するのですから
シート3にはシート1の通りに
なるはずですけどね
（SoulMan） 2021/03/13(土) 01:12

言葉が足りず申し訳ありません。
〇や△を入力してもらった後でも並べ替えをしたいんです。
その順にした表を作成するのではなく。
その場合はVLOOKUPじゃ無理ではないですか？できるのであれば具体的な関数を書いて教えてほしいです。
（リース） 2021/03/13(土) 01:27

実際のデータは、何行何列程度あるのですか

（マナ） 2021/03/13(土) 02:37

 おはようございます。
勘違いしてましたらごめんちゃいですけど、、
A1に　=Sheet1!A1
B1に　=VLOOKUP($A1,Sheet2!$A$1:$E$3,COLUMN(B1),FALSE)
と入力してSheet1を並び替えたら↓の様になりませんか？

 =Sheet1!A1　=VLOOKUP($A1,Sheet2!$A$1:$E$3,COLUMN(B1),FALSE)
1234	田中太郎	〇	△	0	#REF!	#REF!
5678	高橋次郎	×	×	〇	#REF!	#REF!
9999	山田花子	△	〇	0	#REF!	#REF!
0	#N/A	#N/A	#N/A	#N/A	#N/A	#N/A
0	#N/A	#N/A	#N/A	#N/A	#N/A	#N/A
（SoulMan） 2021/03/13(土) 05:15

Sheet1とSheet2の管理番号で過不足がないことが前提

 Sub test()
    Dim dic As Object
    Dim r As Range, c As Range
    Dim y, x

    Set dic = CreateObject("scripting.dictionary")
    Set r = Sheets("sheet2").Cells(1).CurrentRegion

    For Each c In Sheets("sheet1").Cells(1).CurrentRegion.Columns(1).Cells
        dic(c.Value) = Application.Match(c, r.Columns(1), 0)
    Next

    y = Application.Transpose(dic.items)
    x = Evaluate("Transpose(row(1:" & r.Columns.Count & "))")
    r.Value = Application.Index(r.Value, y, x)

 End Sub

（マナ） 2021/03/13(土) 07:24

↑やっぱり、普通は、並び替えだけでなく、
行追加・削除もあるでしょうし、使えませんね。

（マナ） 2021/03/13(土) 07:34

 方法は色々あるんでしょうが、、、
要は、Sheet2の行番号がSheet1と連携すればいいわけで、、

 =INDEX(Sheet2!$A$1:$E$3,MATCH(Sheet1!$A1,Sheet2!$A$1:$A$3,0),COLUMN(A1))
1234	田中太郎	〇	△	0	#REF!	#REF!
5678	高橋次郎	×	×	〇	#REF!	#REF!
9999	山田花子	△	〇	0	#REF!	#REF!
#N/A	#N/A	#N/A	#N/A	#N/A	#N/A	#N/A
#N/A	#N/A	#N/A	#N/A	#N/A	#N/A	#N/A
（SoulMan） 2021/03/13(土) 07:57

 それでも出力はSheet3にするでしょうけどね。。。
Option Explicit
Sub てすと()
Dim MyA As Variant
Dim MyB As Variant
Dim MyC As Variant
Dim x As Variant
Dim i As Long
Dim j As Long
Dim k As Long
MyA = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 1).Value
MyB = Sheets("Sheet2").Range("A1").CurrentRegion.Value
ReDim MyC(LBound(MyB, 1) To UBound(MyB, 1), LBound(MyB, 2) To UBound(MyB, 2))
For i = LBound(MyA, 1) To UBound(MyA, 1)
    x = Application.Match(MyA(i, 1), Application.Index(MyB, 0, 1), 0)
    If Not IsError(x) Then
        k = k + 1
        For j = LBound(MyB, 2) To UBound(MyB, 2)
            MyC(i, j) = MyB(x, j)
        Next
    End If
Next
With Sheets("Sheet3")
    .Cells.Clear
    .Range("A1").Resize(k, UBound(MyC, 2)).Value = MyC
End With
Erase MyA, MyB, MyC
End Sub
 書いておいてなんですが、関数なら一行ですむことをわざわざコードにしなくてもいいと思いますよ。。。いらぬお世話かもしれませんが、、、
（SoulMan） 2021/03/13(土) 08:19

Power Queryを使える環境なら

 １）Sheet1の表の右端に、作業列追加（下記例では、F～J列）
      A        B          C         D    E    F   G   H   I   J
 1 管理番号   氏名      グループ名  xx  yyy   1   2   3   4   5	
 2  1234     田中太郎   グループ１  a    g			
 3  9999     山田花子   グループ２  b    h
 4  5678     高橋次郎   グループ２  c    i

 ２）Sheet1をテーブルに設定
 　　テーブル名:管理者用

 ３）Power Queryエディターにデータを取り込む
 ４）データ型を適切なものに変換
 ５）必要な列以外を削除（A、B、F～J列以外）
 let
    ソース = Excel.CurrentWorkbook(){[Name="管理者用"]}[Content],
    変更された型 = Table.TransformColumnTypes(ソース,{{"管理番号", type text}}),
    削除された他の列 = Table.SelectColumns(変更された型,{"管理番号", "氏名", "1", "2", "3", "4", "5"})
 in
    削除された他の列

 ６）クエリ名を利用者用1に変更
 ７）閉じて次に読み込む：Sheet2にテーブル出力
      A        B          C   D   E   F   G 
 1 管理番号   氏名        1   2   3   4   5	
 2  1234     田中太郎			
 3  9999     山田花子
 4  5678     高橋次郎

 ８）Sheet2に、○△☓等の値を入力
 ９）１）で追加したSheet1の作業列にVlookupで、８）の値を取得
 10）９）の作業列が邪魔なら非表示
 11）Sheet3以降も同様に、クエリ追加：利用者2,3.4…

これで、準備完了

 12）管理者は、Sheet1のデータを並び替え、行追加等をしたらクエリ更新
 13）利用者は、Sheet2以降に○△☓を入力

（マナ） 2021/03/13(土) 08:22

＞マナさん

行の追加は対応したいですね。その旨明記していなかったので、後で訂正しておきます。実際には40から50が最大だと思います。
あとPowerQueryが使える環境ではないですね…すみません

＞SoulManさん

関数の方についてですが、それは
シート１（名簿管理）、シート２（入力者用）、シート３（表出力用）という認識であってますか？
その形は関数で簡単にできると思うんですが、今回はシート２（入力者用）をシート１に合わせて並び替えたいという話です。VLOOKUP、INDEXはセルの値を返す関数ですので、その運用がしたい場合はできないと思うのですが…

（リース） 2021/03/13(土) 09:10

 そもそも論ですけど、、
Sheet2に入力しながら関数もというのは無理がありますよね？

 マクロならSheet2に出力出来ますが、なかった場合などを考えると
Sheet3に出力することになると思います。

 いずれにしても
 >シート１（名簿管理）、シート２（入力者用）、シート３（表出力用）という認識であってますか？
この形になると思います。

 それならば、、関数でいいのでは？というのが私の意見です。

 なので私のコードの出力先をShee2にすればSheet2の内容が書き換わります。
でも実際の運用ではSheet3に出した方がいいんじゃないんですか？

 まぁ、、ここから先は色々な事情がおありでしょうからお任せしますけど。。。
（SoulMan） 2021/03/13(土) 09:22

そうですね。なのでマクロでという話をタイトルにも入れました。
出した方がいいという、出力先が欲しい訳ではないのです。「入力用シートが管理用シートと同じ並び順になるようにしたい」
という事です。あなたのいうシート2が入れ替わって欲しいのてあって、入れ替わった後のシート3を手に入れたいということではありません。
それがマクロを用いても難しいという話であれば、他の方法を考えようと思います。
（リース） 2021/03/13(土) 12:50

 必ずSheet1とSheet2が同じか又はなかった時の対処を書けばいいでしょう
関数も出力してから値にすればいいわけでその過程を記録すればコードは簡単に入手出来るでしょう。

 >一応関数を使って色々試してみたのですがうまくいかず、作ったことのないマクロを使用しないと実現

 Sheet2に入力したのは関数ですか？値ですか？
慣れていないマクロに手を出すより現実的な方法の方がいいのでは？
と提案したまでです。

 では、、では、、

    If Not IsError(x) Then
        k = k + 1
        For j = LBound(MyB, 2) To UBound(MyB, 2)
            MyC(i, j) = MyB(x, j)
        Next
    Else
        'ここになかった場合の対処を記述する
    End If
（SoulMan） 2021/03/13(土) 13:47

 >それがマクロを用いても難しいという話であれば、他の方法を考えようと思います。

 既に関数でもマクロでも出来てますよね？
まさか出力先のSheet3をSheet2に変えることも出来ないんじゃないですよね？

 要は運用方法だと思います。それはあなたしかわからな部分がありますのである程度は応用が必要なんじゃないでしょうか？
（SoulMan） 2021/03/13(土) 14:19

 Sub test2()
    Dim dic As Object
    Dim ws As Worksheet
    Dim r1 As Range, r2 As Range, c As Range
    Dim n As Long
    Dim m
    Dim y, x
    Dim flg As Boolean

    Set dic = CreateObject("scripting.dictionary")
    Set r1 = Sheets("sheet1").Cells(1).CurrentRegion.Columns(1).Cells

    For Each ws In Worksheets
        If ws.Name <> r1.Parent.Name Then
            Set r2 = ws.Cells(1).CurrentRegion
            n = r2.Rows.Count + 1
            Set r2 = r2.Resize(n)

            For Each c In r1
                m = Application.Match(c, r2.Columns(1), 0)
                dic(c.Value) = IIf(IsNumeric(m), m, n)
            Next
            y = Application.Transpose(dic.items)
            x = Evaluate("Transpose(row(1:" & r2.Columns.Count & "))")

            r2.ClearContents
            r2.Resize(r1.Count).Value = Application.Index(r2.Value, y, x)
            r2.Resize(r1.Count, 1).Value = r1.Value
        End If
    Next

 End Sub

（マナ） 2021/03/13(土) 15:25

マクロ初心者さんでも組みやすいマクロをご案内します。
マクロの記録を使ってやってみてください。
1.シート2をシートごとコピーして新しいシートをつくる
2.シート1の名簿をシート2にコピー
3.シート2のデータ部分にvlookup関数で1で作ったシートを参照する式を書き込む
4.3で作ったデータ部分をコピーして同じ範囲に値貼り付け
5.1で作ったシートを削除

3のところはiferrorも使って戻り値エラーのところを空白にすると良いです。
（半可通） 2021/03/13(土) 17:06

 または、全く発想を変えてSheet1もSheet2も同じように並び替えるということなら
昇順と降順をそれぞれ記録して交互に実施すればSheet1もSheet2も同じように並び替わりますけどね。。。

 Option Explicit
Sub 降順()
    With Worksheets("Sheet1")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("A1") _
            , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets("Sheet1").Range("A1").CurrentRegion
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    With Worksheets("Sheet2")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets("Sheet2").Range("A1").CurrentRegion
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

 Sub 昇順()
    With Worksheets("Sheet1")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets("Sheet1").Range("A1").CurrentRegion
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    With Worksheets("Sheet2")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets("Sheet2").Range("A1").CurrentRegion
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

 なるべく記録のコードを残したかったですけど、、With句を使った方が見やすいでしょうから
少し修正しました。
（SoulMan） 2021/03/13(土) 17:21

コメント返信：

[ 一覧(最新更新順) ]

[[20210312211707]] 『マクロを利用して別のシートと同じ順に並び替えた』（リース） ページの最後に飛ぶ

[[20210312211707]]　『マクロを利用して別のシートと同じ順に並び替えた』（リース）　ページの最後に飛ぶ