● 顧客IDが同じうちは横に値を結合していくマクロの例～SUMIF関数では条件付きの文字列の結合ができないので、その代わりのVBAコード（ただし顧客ID等々ごとにまとめるだけ）
※補足：関数でやる方法について（2020/03/12追記）
関数でもラクにできる方法（作業列を追加して処理する方法）を見つけました。
※下図はYahoo知恵袋より引用しました。（関数での方法は2016以降限定。VBAでの方法はどのバージョンでもOKです。）
以下のサイトをご参考にしてみてください。
『 Yahoo知恵袋：エクセルかアクセスで作業したいのですが教えてください 』（上の図）
『 Yahoo知恵袋：重複データをまとめる方法を教えてください。 （関数での方法は2016以降限定。VBAでの方法はどのバージョンでもOKです。） 』（下の図）
VBAを経験されたことが無い方、あるいは、小さな表の場合、などには本記事よりもこの「関数を使う方法」のほうが簡単な場合も少なくないですので、先にこちらをお試しになったほうが良いかもしれません。（大きな表の場合や何らかの条件がつく場合はVBAのほうがかえって簡単かもしれません。）
特に、本記事のVBAでは、「あらかじめ顧客ID順にならべかえをしておく必要があります」が、この関数を使う場合は、バラバラに並んでいても大丈夫ですので。
当方で作ったサンプルファイル（多段的になった式を、1段階ずつ分解したモノ）もありますのでこちらもご参考にしてみてください。ESETでウィルスチェックしてあります。
↓
ダウンロードはこちら（yokoketugou.zip）
※バージョン2003以前は、IFERROR関数がないので、IFとISERROR関数を使って代用する必要があります。あるいは、自作のIFERROR関数を標準モジュールに作っておく必要があります。
※補足02：その他のVBAでやる方法について（2020/05/16追記：Dictionaryを使う方法）
こちらのコードのほうがスマートなので、是非、この記事を読む前に試してみてください。
『 エクセルの顧客データを、次のように加工したいのですがどうすでばいいでしょうか？ 』
★ はじめに
例えば以下の図ようなことをしたい時がありませんか？
顧客IDごと、あるいは、顧客の氏名・住所・TELごとに、何らかのリスト（購入品履歴など）を縦方向から横方向につなぎ変えたい場合です。
SUMIF関数はある条件のもとに数値の合計はできますが、文字列の結合ができません。（Excelのことを知らないもんですからそれができる関数が無いと知って驚きましたけど・・・。でもよく考えたらAccessでも無いかもですね。SQLでもできるみたいですけどそれだと慣れないとかえって難しいので、兼任SEさんの場合は VBAでやるほうが多分簡単な気がします。僕はSQLも音痴なので理解ができませんでした。関数、SQL、よりも、VBAのほうが簡単でした。）
Webを色々と漁ってみたのですが、汎用的に使えるとか、書き換えができそうな、とかの小さなプログラムがありませんでした。
関数だとすごくややこしくなって面倒くさいので、VBAでやることにしてみました。
（複数の関数のかけあわせができる人、本当に尊敬します。）
ここでは、あとで作り変えもできる、ちいさなプログラムを作ってみました。
（素人なので美しくないコードですみません！）
顧客IDごとに、B列の値が横に結合していき、C列の各顧客の最後の行（もとから1行しかなければその行）に、その結合された値を埋め込んでいくプログラムです。
関数でやる方法を調べたら、例えばC列の全セルに値が表示されてしまう方法がとても多かったです。
例えば、「B列の値が１つずつ結合されたものが上から順番にC列の全セルに埋め込まれてしまう方法」が多かったでした。
でもそれだと、最終的に「顧客名簿集約」を見据えたときに後の処理が面倒くさいです。
逆に例えば、A列に顧客ごとに、氏名・住所・TELが同じ値が入っている場合、「C列の各顧客ごとの最後の行だけに 結合された値が入っていれば」、上図のようにC列でオートフィルタを使って、購入製品履歴付の名簿が作成しやすいです。
なお、どの列に顧客情報が入っているかとか、どの列に、結合した値を埋め込むかは、最初のサンプルプログラムではA列、B列、C列、で決め打ちしてしまっていますが、2つ目のサンプルプログラムのように、ユーザーに問い合わせるように作り変えれば、どの列がどうでも、自由が利くと思います。
また、モトデータが全部残っているほうが、のちにまた別の加工に使えるかもしれません。
そんなこともあって、C列のすべてのセルに値を埋め込むことはやめてあります。
では以下、サンプルコードです。
冒頭の図のように、1行目に「F01」～｛F03」の列名を入れ、同様に値を入れてから、以下のコードを「標準モジュール」にコピペすれば動きを確認できると思います。
★ YokoMargeTest01()・・・A、B、C、の3つの列を使ってのデータの横結合
あらかじめ、顧客ID順に、表を並べ替えしておく必要があります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
' ' Sub YokoMargeTest01() Dim Cnt01 As Long '行を指定するためのカウンタとしての値を代入するための変数を用意 Dim LngStrtRow01 As Long 'スタートする行の値を代入するための変数を用意 Dim VrntPrvId01 As Variant '1つ前のセルの値を代入するための変数を用意 Dim VrntCrntId01 As Variant '現在のセルの値を代入するための変数を用意 Dim VrntTmpVal01 As Variant 'どんどんと値を結合したものを代入するための変数を用意 Cnt01 = 0 '一応初期化 VrntPrvId01 = Null '一応初期化 VrntCrntId01 = Null '一応初期化 VrntTmpVal01 = Null '一応初期化 LngStrtRow01 = 2 '初期化 1行目は列名なので、実データは2行目からとなるため、初期値を2としました。 For Cnt01 = 0 To (1 + 8) '列名1行分＋実データ8行分 ※実データが100行あれば、8を100に書き換えます。 If Cnt01 = 0 Then '実データの1行目だけ、 '1つ前のセルが列名になってしまうので以下の処理 '変数にB列の値を代入するだけです。 'C列にB列の横結合値を埋める処理は、次の分岐の中でやります。 '理由は、2行目以降に行かないと、顧客IDが前行と同じかどうかの判断がつかないためです。 VrntTmpVal01 = Range("B" & LngStrtRow01) Else '列名以外の、実データの2行目以降は、以下の処理 'C列にB列の横結合値を埋める作業はこちらの分岐の中でやります。 VrntPrvId01 = Range("A" & LngStrtRow01 + Cnt01 - 1) 'A列（顧客ID列相当）の直前行のセルの値を取得 VrntCrntId01 = Range("A" & LngStrtRow01 + Cnt01) 'A列（顧客ID列相当）の現在行のセルの値を取得 If VrntPrvId01 = VrntCrntId01 Then 'A列（顧客ID列相当）の直前のセルの値と現在のセルの値が同じなら '＝「IDが同じ顧客の行」のうちは、 '以下の処理 VrntTmpVal01 = VrntTmpVal01 & Range("B" & LngStrtRow01 + Cnt01) 'どんどん値を結合 Else 'A列（顧客ID列相当）の直前のセルの値と現在のセルの値が違う値・・・、 '＝「IDが違う顧客の行」に変わったら、 '以下の処理 Range("C" & LngStrtRow01 + Cnt01 - 1) = VrntTmpVal01 '1つ前の行のC列に結合した値を入力 VrntTmpVal01 = Null '一応いったん初期化して VrntTmpVal01 = Range("B" & LngStrtRow01 + Cnt01) '今のセルの値を代入 End If End If ' Cnt01 = Cnt01 + 1 '次の行へ移動するために、カウンタをインクリメントします。（＝1つ繰り上げます） ' でも、「For ～ Next 」文の場合は、Forの直後で使う変数の値については、 ' 自動的にインクリメント（1つだけの繰り上げ）をして、自動的に代入してくれるので ' 「Cnt01 = Cnt01 + 1 」と書かなくてもOKです。 なので、一応コメントアウトしておきます。 Next Cnt01 End Sub ’ ’ |
※「標準モジュール」は「開発」タブを出して、「Visual Basic」のボタンを押すと「Visual Basic Editor」の画面が出ますので、「挿入」→「標準モジュール」を押します。
そのあとに、上記のコードをコピペして、実行します。
実行は、プログラムのどこでもいいのでいったんクリックして点滅カーソルを表示させてから、下図の赤枠のボタンを押すか「F5」キーを押すと実行できます。
※プログラムのどこでもいいのでいったんクリックすることで、そのプログラムを「選択した」という意味になります。それをしないと下図のような変なダイアログが出てきてしまいますのでご注意ください。
★ YokoMargeTest02()・・・ユーザーが指定した列を使ってのデータの横結合
※注！！こちらのあらかじめ、顧客ID順に、表を並べ替えしておく必要があります。
前出の「YokoMargeTest01()」のプログラムを少し作り変えて、処理する列が変わってもいいように、自由に設定できるようにしてみました。
ただ、エラー処理やいろんな処理をしてないのでユーザーに列を指定させるときに、キャンセルを選ぶとエラーになります。
でも一応、最小限、動きますので、あと何を付け足したらエラーが出ないようになるかご自分でも考えてみてください。
これも、前出のプログラム同様に、3列を保持するシートを作成し、標準モジュールにコピペして実行すれば、動作を確認できます。
相変わらずに、レベルの低い、美しくないプログラムですが、VBA初心者の方のご参考になれば幸いです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
' ' '' Sub YokoMargeTest03() 'YokoMargeTest01() を処理する列が変わってもいいように、 '自由に設定できるように作り変えたものです。 'とはいえ、エラー処理やいろんな処理をしてないので 'ユーザーに列を指定させるときに、キャンセルを選ぶとエラーになります。 'でも一応、最小限、動きますので、あと何を付け足したらエラーが出ないようになるか 'ご自分でも考えてみてください。 '相変わらずに、レベルの低い、美しくないプログラムですが、 'VBA初心者の方のご参考になれば幸いです。 Dim answ01 As Integer '並べ替えが済んだかをユーザーに聞いたときに応え格納するための変数を用意（6=はい=yes、7=いいえ=No） Dim Cnt01 As Long '行を指定するためのカウンタとしての値を代入するための変数を用意 Dim LngStrtRow01 As Long 'スタートする行の値を代入するための変数を用意 Dim VrntPrvId01 As Variant '1つ前のセルの値を代入するための変数を用意 Dim VrntCrntId01 As Variant '現在のセルの値を代入するための変数を用意 Dim VrntTmpVal01 As Variant 'どんどんと値を結合したものを代入するための変数を用意 Dim StrCmparKeyClmn As String 'どの列の値を比較したいか、顧客ID列などを指定するための変数を用意（A、B、C・・・などの列番号をユーザーに入れてもらう） Dim StrValMargClmn As String 'どの列の値を横に結合していきたいか、値の列を指定するための変数を用意（同上） Dim SrtWritDistClmn As String 'どの列に横結合した値を書き込みたいか、を指定するための変数を用意（同上） Dim LngAllRowNum As Long '全部で何行分、この処理をしたいか、の「行数」をユーザーに指定してもらうための変数を用意 Cnt01 = 0 '一応初期化 VrntPrvId01 = Null '一応初期化 VrntCrntId01 = Null '一応初期化 VrntTmpVal01 = Null '一応初期化 LngStrtRow01 = 2 '初期化 1行目は列名なので、実データは2行目からとなるため、初期値を2としました。 '条件にしたい列のチェック '条件にしたい列での並べ替えが済んでるかのチェック。 '並べ替えされてないと同一IDのかたまりがバラバラに存在して横結合されてしまうことがあるので。 answ01 = MsgBox("条件にしたい列（同じ値を持つ列）での並べ変えが終わっていないと" _ & vbCrLf & "" _ & vbCrLf & "正常に処理ができませんが、並べ替えはちゃんと終わっていますか？" _ & vbCrLf & "", vbYesNo + vbExclamation + vbDefaultButton2, "最後の確認") If answ01 = 6 Then ' 6 ＝「 "はい"ボタンを押した とみなします」とあらかじめVBAの決まりで決まっています。 'つまり、並べ替えが終わっているなら '何もしないで次へ ElseIf answ01 = 7 Then ' 7 ＝「 "いいえ"ボタンを押した とみなします」とあらかじめVBAの決まりで決まっています。 'つまり、並べ替えが終わっていないなら、 '何もしないでこのプロシージャの実行を終わる。 '並べ替えが終わってないと、処理が正常にやれないので。 Exit Sub '←このプログラムを終わる、の意味です。 Else 'そのほかの場合も、一応、終わっておく。 Exit Sub End If '半角英数モードにする If IMEStatus <> vbIMEModeOff Then SendKeys "{kanji}" End If '処理する列や行数なをユーザーに問い合わせます。 '「キャンセル」を押されるとエラーになりますけど、 ' そのエラーの回避のコードはご自分でもお考えになってみてください。 StrCmparKeyClmn = InputBox("★０１---どの列の値を比較しますか？「顧客ID」のような列の列番号を入力してください。 A、B、C…などの列番号を半角英数で入力してください。") StrValMargClmn = InputBox("★０２---どの列の値を横に結合しますか？ A、B、C…などの列番号を半角英数で入力してください。") SrtWritDistClmn = InputBox("★０３---どの列に横結合値を書き込みますか？ A、B、C…などの列番号を半角英数で入力してください。") LngAllRowNum = InputBox("★０４---何行分の処理をしますか？ 半角の数字で入力してください。処理したい数よりも大きければOKです。") For Cnt01 = 0 To (1 + LngAllRowNum) '列名1行分＋実データ8行分 ※実データが100行あれば、8を100に書き換えます。 'Cnt01 の値は 0 からスタートしますが、 LngAllRowNum の数の行数まで 以降の処理を繰り返します。 ' 「Next Cnt01 」の行までの内容を繰り返します。 ' 「Next Cnt01」 の１行で、Cnt01 に ＋１ が自動的になされます。 If Cnt01 = 0 Then '最初だけ、1つ前のセルが列名になってしまうので以下の処理 VrntTmpVal01 = Range(StrValMargClmn & LngStrtRow01) Else '列名以外の、実データの2行目以降は、以下の処理 VrntPrvId01 = Range(StrCmparKeyClmn & LngStrtRow01 + Cnt01 - 1) '直前行のセルの値を取得 VrntCrntId01 = Range(StrCmparKeyClmn & LngStrtRow01 + Cnt01) '現在行のセルの値を取得 If VrntPrvId01 = VrntCrntId01 Then '直前のセルの値と現在のセルの値が同じなら '＝「IDが同じ顧客の行」のうちは、 '以下の処理 VrntTmpVal01 = VrntTmpVal01 & Range(StrValMargClmn & LngStrtRow01 + Cnt01) 'どんどん値を結合 Else '直前のセルの値と現在のセルの値が違う値・・・、 '＝「IDが違う顧客の行」に変わったら、 '以下の処理 Range(SrtWritDistClmn & LngStrtRow01 + Cnt01 - 1) = VrntTmpVal01 '1つ前の行のC列に結合した値を入力 VrntTmpVal01 = Null '一応いったん初期化して VrntTmpVal01 = Range(StrValMargClmn & LngStrtRow01 + Cnt01) '今のセルの値を代入 End If End If ' Cnt01 = Cnt01 + 1 '次の行へ移動するために、カウンタをインクリメントします。（＝1つ繰り上げます） ' でも、「For ～ Next 」文の場合は、Forの直後で使う変数の値については、 ' 自動的にインクリメント（1つだけの繰り上げ）をして、自動的に代入してくれるので ' 「Cnt01 = Cnt01 + 1 」と書かなくてもOKです。 なので、一応コメントアウトしておきます。 Next Cnt01 End Sub ' ' ' ' |
なお、もし「あたしゃ、どうしても書き込んだ列に空白を作りたくないんだよ！（さっきまる子ちゃん読んでたから感化されてしまいました）」という場合は、これらのプログラムにそういった処理を埋め込むよりは、別途に「次行以降の、次の異なる値までの空白はすべて現在の値で埋めるプログラム」を作って「Call」で呼び出したほうが、色んな場面で流用も効いて、共用部品として使えるので便利だと思います。
例えば、「空白を同じ値で埋める」というのはよくある作業なので、それができるプログラムを何かのプログラムからCallするほかにも、メニューバーやリボンに「ボタン」として配置して呼び出せるようにしておけば、それもとても便利だと思います。
- 投稿タグ
- ExcelVBA, Excelの独学, ビジネスパソコンの基礎, 自動化
