[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『各シートで集計した結果を，別シートで項目別に分ける方法』（レン）
うまく説明ができるかどうか・・・そもそもexcelでできるのかどうか割りませんが，ご教授ください。
グループごとにアンケートを採りました。
これをグループごとに集計した票があります。
シート１ Ｘグループ
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 番号 氏名 第１希望 第２希望
２ 動物 種類 動物 種類
３ １ あああ いぬ 秋田犬 ねこ ぽめらにあん
４ ２ いいい へび 未定 いぬ チワワ
５ ３ ううう ねこ 三毛猫 さる ニホンザル
６ ４ えええ いぬ 秋田犬 ねこ チワワ
・
・
シート２ Ｙグループ
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 番号 氏名 第１希望 第２希望
２ 動物 種類 動物 種類
３ １ おおお ねこ 三毛猫 ねこ ぽめらにあん
４ ２ かかか いぬ シェパードさる テナガザル
５ ３ ききき いぬ 秋田犬 ワニ
６ ４ けけけ いぬ シェパードねこ ヨークテリシャ
・
・
シート３ Ｚグループ
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 番号 氏名 第１希望 第２希望
２ 動物 種類 動物 種類
３ １ さささ ねこ 三毛猫 ねこ ぽめらにあん
４ ２ ししし ねこ 三毛猫 いぬ チワワ
５ ３ すすす へび 青大将 いぬ ちわわ
６ ４ ててて いぬ 秋田犬 いぬ ちわわ
・
・
・
のように，各グループごとにまとめてあります。
これらを動物ごと（第１希望）にまとめることができるでしょうか？
シート４ 集計
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 番号 動物 種類 Ｘグループ Ｙグループ Ｚグループ
２ １ いぬ 秋田犬 あああ ききき ててて
３ えええ
４ ２ いぬ シェパード かかか
５ けけけ
６ ３ ねこ 三毛猫 ううう おおお さささ
７ ししし
８ ４ へび 青大将 すすす
９ ５ へび 未定 いいい
のように，できないでしょうか？
Ｘ，Ｙ，Ｚのシートの人数が増えたときや，第１希望をかけたときに，シート４の集計の行数が勝手に増えたりしてほしいです。可能でしょうか？
実際はグループ数も多いし，人数も多いので，手集計では大変なので，なんとかシート４（集計用シート）に自動で飛んでくれるとうれしいです。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
回答ではないですが 参照するリストを作成するならタイトルを一意の文言にした方がわかり易いのでは 1 第1希望 第2希望 2 番号 氏名 動物1 種類1 動物2 種類2
同じ名称だと第1希望なのか第2希望なのかも絞れないと思います これで出来るのかは細かく考えてないのでわかりませんが・・・ （なるへそ） 2021/11/11(木) 11:31
最大で、どの程度の数と考えていますか。
＞Ｘ，Ｙ，Ｚのシートの人数が増えたときや，
＞第１希望をかけたときに，
＞シート４の集計の行数が勝手に増えたりしてほしいです。
何回もアンケートを実施するのでしょうか？
毎回、動物と種類を回答する形式なのでしょうか。
形式が変われば、集計方法も今回と違ったものになりそうですが…
どのような使い方を想定されているのでしょうか。
（マナ） 2021/11/11(木) 16:21
もちろんマクロで実現可能でしょう（Dictionaryを使います）。 ただし、作ってもらうだけでは、今後立往生することになります。 例えば、第二希望の対応とか、項目追加とかがあっても困ることになります。 また、その都度、マクロを書くような負荷をかけることでもないように思います。
(1)私の推奨は、簡単な作業でできることにとどめておくことです。
・たとえば、データを以下のように集めて、 動物1,種類1でソートすれば集計表として機能すると思います。 また、これをもとにさらに加工する可能性があるなら、 一層、見栄えだけの加工はしないほうがよく、貴兄の提示のものよりも汎用的でしょう。
A列 B C D E F G H I列
1 動物1 種類1 動物2 種類2 グループ 氏名 X Y Z
2 いぬ 秋田犬 ねこ ぽめらにあん X あああ あああ
3 へび 未定 いぬ チワワ X いいい いいい
4 ねこ 三毛猫 さる ニホンザル X ううう ううう
5 いぬ 秋田犬 ねこ チワワ X えええ えええ
6 ねこ 三毛猫 ねこ ぽめらにあん Y おおお おおお
7 いぬ シェパード さる テナガザル Y かかか かかか
8 いぬ 秋田犬 ワニ space Y ききき ききき
9 いぬ シェパード ねこ ヨークテリシャ Y けけけ けけけ
10 ねこ 三毛猫 ねこ ぽめらにあん Z さささ さささ
11 ねこ 三毛猫 いぬ チワワ Z ししし ししし
12 へび 青大将 いぬ ちわわ Z すすす すすす
13 いぬ 秋田犬 いぬ ちわわ Z ててて ててて
（なお、G列,H列,I列は =IF([@グループ]="X",[@氏名],"") のような式で簡単に作れます。）
・動物1,種類1の内容表示が重複していてビジーな感じを受けるというなら、 「上のセルと同じときはフォントを白にする」ような簡単な条件付き書式で改善できます。
(2)上記方針で、ソートと条件付き書式で対応して、必要列以外を非表示にすると、 下記のようになりますね。
動物1 種類1 X Y Z
いぬ シェパード かかか
けけけ
秋田犬 あああ
えええ
ききき
ててて
ねこ 三毛猫 ううう
おおお
さささ
ししし
へび 青大将 すすす
未定 いいい
(3)どうしてもマクロでというなら、ご自分でできているところまで示してください。 （γ） 2021/11/11(木) 16:33
・データの取得／ファイルから／ブックから で、自ブックを指定するのがポイントです。
・データ更新の前に、ブックの保存が必要です。
let
ソース = Excel.Workbook(File.Contents("D:\***\*******.xlsx"), null, true),
フィルターされた行 = Table.SelectRows(ソース, each Text.Contains([Item], "グループ")),
削除された他の列 = Table.SelectColumns(フィルターされた行,{"Name", "Data"}),
#"展開された Data" = Table.ExpandTableColumn(削除された他の列, "Data", {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6"}, {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6"}),
削除された他の列1 = Table.SelectColumns(#"展開された Data",{"Name", "Column1", "Column2", "Column3", "Column4"}),
昇格されたヘッダー数 = Table.PromoteHeaders(削除された他の列1, [PromoteAllScalars=true]),
フィルターされた行1 = Table.SelectRows(昇格されたヘッダー数, each [番号] <> null and [番号] <> "番号"),
#"名前が変更された列 " = Table.RenameColumns(フィルターされた行1,{{"Ｘグループ", "グループ"}, {"第１希望", "動物"}, {"Column5", "種類"}}),
グループ化された行 = Table.Group(#"名前が変更された列 ", {"グループ", "動物", "種類"}, {{"テーブル", each _, type table [グループ=text, 番号=number, 氏名=text, 動物=text, 種類=text]}}),
追加されたカスタム = Table.AddColumn(グループ化された行, "カスタム", each Text.Combine([テーブル][氏名], "#(lf)")),
削除された列 = Table.RemoveColumns(追加されたカスタム,{"テーブル"}),
ピボットされた列 = Table.Pivot(削除された列, List.Distinct(削除された列[グループ]), "グループ", "カスタム")
in
ピボットされた列
（マナ） 2021/11/11(木) 16:55
（マナ） 2021/11/11(木) 17:06
こんにちわ～ ＾＾
ぜんぜん、ご質問者様からレスが上がってきませんね。。。＾＾；
既に、ご案内ですが。。。
ＶＢＡでしたら、下記の様な感じで、出来るかもしれません←多分。。。(*^ ^*)????? << _ _ >>
１．使用変数宣言
２．シートX，Y，Zをループ処理
３．２．で配列に3シート分、シート名[G名]を追加し第一希望のみの情報に纏める
４．連想配列に 動物と種類をキーとしてグループ毎の氏名を区切り文字で
連結し、一意な情報を作成
５．一度集約シート[書込み用]に、末尾空白文字を除去後書き出し、ソート
６．５．書き出し分を消去後、所定のフォーマットに、作表書き出し
７．後処理、終了
（隠居Z） 2021/11/11(木) 17:13
参考に Sheet4のP:T列を作業列として使用しています。
Sub Test()
Dim myDic As Object, ws(1 To 4) As Worksheet
Dim v() As String, i As Long, c As Range, j As Long
Dim LastRow As Long
Set ws(1) = Worksheets("Sheet1")
Set ws(2) = Worksheets("Sheet2")
Set ws(3) = Worksheets("Sheet3")
Set ws(4) = Worksheets("Sheet4")
ws(4).Columns("P:T").ClearContents
For j = 1 To 3
LastRow = ws(4).Cells(Rows.Count, "Q").End(xlUp).Row + 1
With ws(j).Range("A3", ws(j).Cells(Rows.Count, "A").End(xlUp)).Resize(, 4)
.Copy ws(4).Cells(LastRow, "Q")
ws(4).Cells(LastRow, "P").Resize(.Rows.Count).Value = j
End With
Next
Set myDic = CreateObject("Scripting.Dictionary")
For Each c In ws(4).Range("S2", ws(4).Cells(Rows.Count, "S").End(xlUp))
If myDic.Exists(c.Value) Then
v = myDic(c.Value)
If IsError(Application.Match(c.Offset(, 1).Value, v, 0)) Then
i = UBound(v) + 1
ReDim Preserve v(i)
v(i) = c.Offset(, 1).Value
End If
Else
i = 0
ReDim v(i)
v(i) = c.Offset(, 1).Value
End If
myDic(c.Value) = v
Next
Dim d As Variant, dd As Variant, myNum As Long, k As Long, myRow As Long
ws(4).Cells(1, 1).CurrentRegion.Offset(1).ClearContents
For Each d In myDic.keys
For Each dd In myDic(d)
myNum = myNum + 1: myRow = myRow + 1
For Each c In ws(4).Range("S2", ws(4).Cells(Rows.Count, "S").End(xlUp))
If d = c.Value And dd = c.Offset(, 1).Value Then
k = c.Offset(, -3)
If ws(4).Cells(myRow + 1, k + 3).Value <> "" Then
myRow = myRow + 1
Else
If ws(4).Cells(myRow, "A").Value = myNum Then
ws(4).Cells(myRow + 1, "A").Value = ""
ws(4).Cells(myRow + 1, "B").Value = ""
Else
ws(4).Cells(myRow + 1, "A").Value = myNum '番号
ws(4).Cells(myRow + 1, "B").Value = d '動物
End If
If ws(4).Cells(myRow, "C").Value = dd Then
ws(4).Cells(myRow + 1, "C").Value = ""
Else
ws(4).Cells(myRow + 1, "C").Value = dd '種類
End If
End If
ws(4).Cells(myRow + 1, k + 3).Value = c.Offset(, -1).Value '氏名
End If
Next
Next
Next
Set myDic = Nothing
End Sub
（ピンク） 2021/11/11(木) 18:46
let
ソース = Excel.Workbook(File.Contents("D:\***\*******.xlsx"), null, true),
フィルターされた行 = Table.SelectRows(ソース, each Text.Contains([Item], "グループ")),
削除された他の列 = Table.SelectColumns(フィルターされた行,{"Name", "Data"}),
#"展開された Data" = Table.ExpandTableColumn(削除された他の列, "Data", {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6"}, {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6"}),
フィルターされた行1 = Table.SelectRows(#"展開された Data", each [Column1] <> null and [Column1] <> "番号"),
削除された他の列1 = Table.SelectColumns(フィルターされた行1,{"Name", "Column2", "Column3", "Column4"}),
#"名前が変更された列 " = Table.RenameColumns(削除された他の列1,{{"Name", "グループ"}, {"Column2", "氏名"}, {"Column3", "動物"}, {"Column4", "種類"}}),
並べ替えられた行 = Table.Sort(#"名前が変更された列 ",{{"動物", Order.Ascending}, {"種類", Order.Ascending}}),
グループ化された行 = Table.Group(並べ替えられた行, {"グループ", "動物", "種類"}, {{"テーブル", each _, type table [グループ=text, 番号=number, 氏名=text, 動物=text, 種類=text]}}),
グループ化された行1 = Table.Group(グループ化された行, {"動物", "種類"}, {{"カウント", each Table.RowCount(_), Int64.Type}}),
削除された列1 = Table.RemoveColumns(グループ化された行1,{"カウント"}),
並べ替えられた行1 = Table.Sort(削除された列1,{{"動物", Order.Ascending}, {"種類", Order.Ascending}}),
追加されたインデックス = Table.AddIndexColumn(並べ替えられた行1, "番号", 1, 1, Int64.Type),
追加されたカスタム = Table.AddColumn(グループ化された行, "カスタム", each Table.AddIndexColumn([テーブル],"index")),
削除された他の列2 = Table.SelectColumns(追加されたカスタム,{"カスタム"}),
#"展開された カスタム" = Table.ExpandTableColumn(削除された他の列2, "カスタム", {"グループ", "氏名", "動物", "種類", "index"}, {"グループ", "氏名", "動物", "種類", "index"}),
ピボットされた列 = Table.Pivot(#"展開された カスタム", List.Distinct(#"展開された カスタム"[グループ]), "グループ", "氏名"),
マージされたクエリ数 = Table.NestedJoin(ピボットされた列, {"動物", "種類"}, 追加されたインデックス, {"動物", "種類"}, "マージ", JoinKind.LeftOuter),
#"展開された マージ" = Table.ExpandTableColumn(マージされたクエリ数, "マージ", {"番号"}, {"番号"}),
置き換えられた値 = Table.ReplaceValue(#"展開された マージ", each [番号], each if [index] > 0 then "" else [番号],Replacer.ReplaceValue,{"番号"}),
置き換えられた値1 = Table.ReplaceValue(置き換えられた値, each [動物], each if [index] > 0 then "" else [動物],Replacer.ReplaceText,{"動物"}),
置き換えられた値2 = Table.ReplaceValue(置き換えられた値1, each [種類], each if [index] > 0 then "" else [種類],Replacer.ReplaceText,{"種類"}),
並べ替えられた列 = Table.ReorderColumns(置き換えられた値2,{"番号"} & Table.ColumnNames(ピボットされた列)),
削除された列 = Table.RemoveColumns(並べ替えられた列,{"index"})
in
削除された列
（マナ） 2021/11/12(金) 00:08
>ちなみにこれをどこに書き込めば良いのでしょうか？ https://excel-ubara.com/excelvba1/EXCELVBA304.html
（ピンク） 2021/11/12(金) 09:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.