[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『1つのセルへ改行してまとめる』(nabechan)
いつもお世話になっています。 次のことをVBAで実行したいと悩んでいます。。 以前に配列やDictionaryについて教えていただきましたが、 根本的にわかっていないせいか、新しいことはうまくできません。 どなたかご教示願います。
A B C 1 りんご ふじ 東京都 2 りんご つがる 神奈川県 3 りんご おうりん 埼玉県 4 みかん えひめ 北海道 5 みかん 三ケ日 (空欄) 6 みかん 青島 青森県 7 みかん 高知 鹿児島県
↓
A B C 1 りんご ふじ 東京都 つがる 神奈川県 おうりん 埼玉県 2 みかん えひめ 北海道 三ケ日 青島 青森県 高知 鹿児島県
< 使用 Excel:Excel2013、使用 OS:Windows7 >
コメントありがとうございます。 ごめんなさい。マクロでやりたいのです。 (nabechan) 2016/10/17(月) 16:51
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
???さん提言に百票!
あえて 1つのセルに改行して窮屈に配置したい理由は何でしょうか? 見た目が、できあがりと同じになればいいのではないですか?
まぁ、マクロでやるとしても、1つのセルに無理やり閉じ込めるのは、やめたほうがいいと思います。 あとあと、データとして参照する際に、面倒なことになりますので。
(β) 2016/10/17(月) 16:54
組み替えた表の使い道が不明ですが、眺めるだけなら、コメントしたように ??? さんの方式。 あるいは、1行目をタイトル行にして、
E1 に =A1 、F1 に =B1&" "&C1 、E1:F1 を下にフィルコピーしておいて、その表領域が選択された状態で ピボットの挿入、行に E1 のタイトル、F1 のタイトルを指定すれば、それらしいものも出来上がりますね。
(β) 2016/10/17(月) 17:06
産地錯誤しても良いからくっつけて、という事ならば、逆にみかん、三ケ日の産地空欄を、結合後に空欄で表現する意味が判りません。詰めればいいじゃないですか? 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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.