[[20161017161951]]　『1つのセルへ改行してまとめる』（nabechan）　ページの最後に飛ぶ

『1つのセルへ改行してまとめる』（nabechan）

 いつもお世話になっています。
次のことをVBAで実行したいと悩んでいます。。
以前に配列やDictionaryについて教えていただきましたが、
根本的にわかっていないせいか、新しいことはうまくできません。
どなたかご教示願います。

	A	B	C
1	りんご	ふじ	東京都
2	りんご	つがる	神奈川県
3	りんご	おうりん	埼玉県
4	みかん	えひめ	北海道
5	みかん	三ケ日	（空欄）
6	みかん	青島	青森県
7	みかん	高知	鹿児島県

　　↓

	A	B	C
1	りんご	ふじ	東京都
		つがる	神奈川県
		おうりん	埼玉県
2	みかん	えひめ	北海道
		三ケ日	
		青島	青森県
		高知	鹿児島県

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

A列に条件付き書式を設定し、上のセルと自分のセルの文字列が同じならば、フォント色を白にする、とするだけでは駄目ですか？
（???） 2016/10/17(月) 16:43

 コメントありがとうございます。
 ごめんなさい。マクロでやりたいのです。
（nabechan） 2016/10/17(月) 16:51

Sub main()
'Sheet1をSheet2にまとめる

    Dim dic1, dic2, k､rg As Range
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For Each rg In Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 1)
        dic1(rg.Value) = dic1(rg.Value) & IIf(dic1(rg.Value) = Empty, "", Chr(10)) & rg.Offset(, 1)
        dic2(rg.Value) = dic2(rg.Value) & IIf(dic2(rg.Value) = Empty, "", Chr(10)) & rg.Offset(, 2)
    Next rg
    Sheets("Sheet2").Cells.ClearContents
    Set rg = Sheets("Sheet2").Range("A1")
    For Each k In dic1.keys
        rg.Value = k
        rg.Offset(, 1).Value = dic1(k)
        rg.Offset(, 2).Value = dic2(k)
        Set rg = rg.Offset(1)
    Next k
End Sub
（mm） 2016/10/17(月) 16:53

 ???さん提言に百票！

 あえて　１つのセルに改行して窮屈に配置したい理由は何でしょうか？
 見た目が、できあがりと同じになればいいのではないですか？

 まぁ、マクロでやるとしても、１つのセルに無理やり閉じ込めるのは、やめたほうがいいと思います。
 あとあと、データとして参照する際に、面倒なことになりますので。

（β） 2016/10/17(月) 16:54

 組み替えた表の使い道が不明ですが、眺めるだけなら、コメントしたように ??? さんの方式。
 あるいは、１行目をタイトル行にして、

 E1 に　=A1 、F1 に　=B1&" "&C1 、E1:F1 を下にフィルコピーしておいて、その表領域が選択された状態で
 ピボットの挿入、行に　E1 のタイトル、F1 のタイトルを指定すれば、それらしいものも出来上がりますね。

（β） 2016/10/17(月) 17:06

例えばりんごを1行にまとめると、「ふじ、つがる、おうりん」と「東京都、神奈川県、埼玉県」としたい、という事ですよね？
この場合、元は「ふじ」=「東京都」だった訳ですが、くっつけてしまうと、「ふじ」=「埼玉県」とも受け取れてしまうので、くっつけない方が正確なのではないかと思います。
なので、くっつけたように見えるよう、文字を見えなくする案を出しました。

産地錯誤しても良いからくっつけて、という事ならば、逆にみかん、三ケ日の産地空欄を、結合後に空欄で表現する意味が判りません。詰めればいいじゃないですか？ B列とC列は1対1なのだ、というならば、ばらばらな行のままにすべきでしょう。

それと、Dictionaryに言及するということは、データが重複する場合もあるのでしょうか？現状の例では、まったく重複がないので、処理が簡単ですが、実は違う、とか後から言われそうで…。もし「スターキング、東京都」という組合せもあった場合は、どうしたいのでしょう？「東京都」を1行にまとめてしまうと、ズレますよ？
（???） 2016/10/17(月) 17:07

 みなさま　コメントありがとうございます。
この処理では、エクセルの機能を果たさないことは充分わかります。
ただ上司の指示なので、仕方ありません。（泣）

 A列以外の重複は、ありません。
B列とC列は、1対1です。

 mmさんのコードを実行させていただき、思ったように作成することができました。
勉強させていただきます。ありがとうございました。

（nabechan） 2016/10/17(月) 17:17

 何度も申し訳ございません。
A列の項目毎のC列の最初に空欄があった場合、行を詰めてしまいます。

 dic2(rg.Value) = dic2(rg.Value) & IIf(dic2(rg.Value) = Empty, "", Chr(10)) & rg.Offset(, 2)

↑この部分をどう変更させていただいたらよいですか？　
ちなみにB列に空欄があることはありません。
（nabechan） 2016/10/17(月) 17:44

Sub main()'修正案
'Sheet1をSheet2にまとめる

    Dim dic1, dic2, k､rg As Range
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For Each rg In Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 1)
        dic1(rg.Value) = dic1(rg.Value) & Chr(10) & rg.Offset(, 1)
        dic2(rg.Value) = dic2(rg.Value) & Chr(10) & rg.Offset(, 2)
    Next rg

    Sheets("Sheet2").Cells.ClearContents
    Set rg = Sheets("Sheet2").Range("A1")
    For Each k In dic1.keys
        rg.Value = k
        rg.Offset(, 1).Value = Mid(dic1(k), 2)
        rg.Offset(, 2).Value = Mid(dic2(k), 2)
        Set rg = rg.Offset(1)
    Next k
End Sub
（mm） 2016/10/17(月) 18:08

 mmさん、ありがとうございます！
思い通りになりました。
本当に助かりました。
（nabechan） 2016/10/17(月) 18:21

コメント返信：

[ 一覧(最新更新順) ]

[[20161017161951]] 『1つのセルへ改行してまとめる』（nabechan） ページの最後に飛ぶ

[[20161017161951]]　『1つのセルへ改行してまとめる』（nabechan）　ページの最後に飛ぶ