Excel（エクセル）活用コミュのVBA セルの値の連結

こんにちは。一つ質問がありますのでよろしくお願いします。
以下のようにセルにデータが入っています。
　　　　A　　　　B
1　　1/10　　○○病院
2　　1/15　　△△病院
3　　1/20　　○○病院
4　　1/21　　□□病院

上の表のデータを一つのセルに転記したいのですが、同じ病院の場合は日付をまとめたいと考えています。※表の範囲ははA1～B8とします。
例）C1セルに「1/10,1/20○○病院1/15△△病院,1/21□□病院」と転記したい。

これをフォームボタンをクリックすることで行いたいのですが、VBAへの記述方法がわからず困っています。ただ単にA1とB1を結合するならCells（3,1).Value=Cells(1,1).VAlue & Cells(1,2).Value & …としていけばいいのですが、同じ病院が含まれるのでできればまとめたいと考えています。

Excelは2010、win7です。
よろしくお願いします。

コメント(44)

最初
全て
最新の40件

前

[5] mixiユーザー 02月20日 08:25

おはようございます。
ミキスタさん、すいません。>>4で書いたコードに間違いはなかったみたいです。
家のOfficeではだめでしたが会社のOfficeでは問題なく動作しました。

おそらく家のOfficeがfor Macだったため不具合があったものと思われます。

[6] mixiユーザー 09月01日 15:40

お久しぶりです。このトピックのことで再質問です。

>>4で書いた構文をセルの値が変わったので書き直して実行していますが、やはり前述した
>>1.自分のファイルで試したところ、何もないシートに例のように値を入れて試したら問題なく動作しましたが、2列×8行ある表に空白がのセルがあった場合、C1セルの値の最後に「,,,」というように空白の分だけ「,」が入ります。これを以下空白の場合は「,」が入らないように...

のところがどうしても「,」が入ってしまいます。
恐らく　列のセルに関数で空白処理をしているからだと思うのですが、「,」が続かないようにするにはどうすればいいでしょう？

-シートにある表-
　　　AC　　　　AD
6　　1/10　　○○病院
7　　1/15　　△△病院
8　　1/20　　○○病院
9　　1/21　　□□病院
10
11
12
13
※AC6～AC13、AD6～AD13にはvlookup関数をいれ、IF構文で空白処理がされています。

-実行するマクロ-
Sub main()

Dim HN
Dim HName As String
Dim Dstr As String
Dim i As Long, j As Long
Dim Flag As Boolean
Dim FindCell3 As Variant
Dim MaxRow As Integer

Set FindCell3 = Range("A4:A39").Find(Range("AC4"))　'転記する行を決定
MaxRow = Range("AC5").End(xlDown).Row　'AC列の最終行取得
ReDim HN(0)
HN(0) = Cells(6, "AD")

For i = 7 To MaxRow
HName = Cells(i, "AD")
Flag = True

For j = 0 To UBound(HN)
If HN(j) = HName Then
Flag = False
Exit For
End If
Next

If Flag Then
ReDim Preserve HN(UBound(HN) + 1)
HN(UBound(HN)) = HName
End If
Next

Dstr = ""
For i = 0 To UBound(HN)
For j = 6 To MaxRow
If Cells(j, "AD") = HN(i) Then
Dstr = Dstr & "," & Format(Cells(j, "AC"), "m/d")
End If
Next

Dstr = Dstr & " " & HN(i)
Next

Dstr = Right(Dstr, Len(Dstr) - 1)
Cells(FindCell3.Row, "J") = Dstr

End Sub

-このまま実行すると転記先セルに入力される値-
「1/10,1/20 ○○病院,1/15 △△病院,1/21 □□病院,,,,」
これを
「1/10,1/20 ○○病院,1/15 △△病院,1/21 □□病院」
としたいです。

[7] mixiユーザー 09月01日 16:31

>>[6]
例えばAC列のセルが空白(長さ0の文字列)の場合、飛ばす
ということであれば、そのセルが空白か判断する条件を設ければ良いのでは？

[8] mixiユーザー 09月01日 16:43

>>[7] ありがとうございます。
>例えばAC列のセルが空白(長さ0の文字列)の場合、飛ばす
ということであれば、そのセルが空白か判断する条件を設ければ良いのでは？

飛ばすというのが合っているかはわからないのですが、AC列のループを空白（処理したセル）が出た時点で止めたい（？）と思っています。
具体的にはMaxRowの取得方法なのかと考えているのですが、ネットで調べても最終行の取得方法はでてきても空白処理したセルの最終行の求め方が出てきませんでした。
マリ男さんはお詳しいのでもしご存知でしたら教えてください。

[9] mixiユーザー 09月01日 16:51

>>[6]
よくよくコードを読むと配列に病院名を入れていますね
それであれば、病院名を入れるときに病院名が空白のときは
その処理をしないというように条件を入れてあげれば問題ないですね

[10] mixiユーザー 09月01日 16:56

>>[8]
>AC列のループを空白（処理したセル）が出た時点で止めたい（？）と思っています。
であれば、AC列のセルが空白ならループを抜けるようにすれば良いのでは？

空白の存在する表の最終行の求め方としては
間に空白がないのであれば、COUNT系の関数を使って求める
間に空白があるのであれば、とりあえず表の最下行を求めるなりして
そこからループで1行ずつ上方向に見ていって、空白でないセルに
到達したらその行を最終行とする、といった感じですかね

[11] mixiユーザー 09月01日 17:39

>>[10]
>に空白がないのであれば、COUNT系の関数を使って求める
間に空白があるのであれば、とりあえず表の最下行を求めるなりして
そこからループで1行ずつ上方向に見ていって、空白でないセルに
到達したらその行を最終行とする、といった感じですかね

一度はこの方法に辿り着いたのですが、表の最中に空白あるなし関係なしに只の空白と関数で空白処理して空白に見えてるセルを区別するやり方が分からず、断念しました。。。(笑)
マリ男さんこの方法分かります？
出来たら具体的な数式など教えて頂けると助かります。

[12] mixiユーザー 09月01日 18:21

>>[11]
>只の空白と関数で空白処理して空白に見えてるセルを区別するやり方
どういった場合を想定しているのでしょうか？
単純に表があって、そこには式が入力してあり、空白処理がなされている
という状況であれば、先程も書きましたが、まずEndプロパティを使って
表の最下行を求める
その後、その最下行から上方向にループで見ていくという感じですが

まあ、空欄セルはEmptyですからそこから空欄セルと空白セルを
区別するとかもできますから、その辺を使えば何とかなるのでは？

とりあえず今回の場合、AC列のセルが空白(長さ0の文字列)でなく
その下のセルが空白のときはその行を最下行とみなす
ということであれば、配列に病院名を入れるループの最初に
AC列が空白である場合、MaxRowをi - 1にしてからForループを抜ける
というような処理を追加してあげれば、解決するかと思いますよ

[13] mixiユーザー 09月01日 18:27

>只の空白と関数で空白処理して空白に見えてるセルを区別
他にもちょっと面倒かもしれませんが、TypeName関数を使えば
空欄セルは「Empty」、長さ0の文字列の入ったセルは「String」が返りますから
そこから区別するといことも可能ですね

[14] mixiユーザー 09月01日 18:38

>>[12]
ふーむ。説明してもらった半分以上がピンときてません。
>どういった場合を想定しているのでしょうか？
下から上にループしたらAD13に数式が入っているのでエクセルは空白とみなさないので最終行を13と取得してしまうのです。

出来れば文章ではなく簡単な数式で結構ですので使用例を示していただけませんか？
それとも文章で分からないなら諦めなさいと暗に示されてるのでしょうか？(笑)
すいません。読解力なくて(笑)

[15] mixiユーザー 09月01日 18:42

>>[14]
>空白とみなさないので最終行を13と取得してしまうのです
どのようなコードを書いているのでしょうか？

最下行からループして
If セル ≠ 長さ0の文字列 Then ループを抜ける
ということをすれば良いのですが

[16] mixiユーザー 09月01日 18:45

いっそ発想を変えて、セル値を連結した文字列を最終的にセルに書き戻す前に、
その文字列中の末尾にある","を取り除く処理を加えるというのでも良いかも知れませんね。

[17] mixiユーザー 09月01日 22:55

>>[15]
以前はMaxRow=Range("AC5").End(xlUp).Row
としてました。

[18] mixiユーザー 09月01日 22:56

>>[16]
そういうアプローチもありですね。
取り除く処理が書けませんが(笑)調べてみます。

[19] mixiユーザー 09月01日 23:21

>>[17]
>以前はMaxRow=Range("AC5").End(xlUp).Row
これはAC1:AC5が表のときでしょうか？
「以前は」ではなく今回のコードはどうなっていますか？
というより、ここまで説明してきましたが考えていますか？
コードの提示がないので、考えているのか、分かりません
コードがなければ、どこを直せば良いなどのアドバイスもできません

コードを催促する余裕があるなら、御自分で考えたコードを
載せてみてはいかがでしょうか？

[20] mixiユーザー 09月01日 23:26

>>[19]
コードはもう書きましたが？
書いたコードはMaxRowを上からでも下から取得しても結果が変わらなかったので書いたコードでは上からのままにしています。

[22] mixiユーザー 09月01日 23:30

>>[19]
以前のコード間違ってますね。
AC14から上に向かって最終行を取得してました。

[23] mixiユーザー 09月01日 23:34

>>[20]
もう、面倒なので答えの一例を出してしまいますが
これまでの説明、特に>15ではほぼ答えを書いているので
これで分からなければ、この方法は諦めた方が良いと思います
というより、しっかりと勉強し考えれば分かるはず
これまで質問してきたことが身になっていない証拠ではないでしょうか

現在のコードが分からないので何のアドバイスもすることが出来ません
Endプロパティで求めることしかしていないということですか？
>15で書いたように取得した最下行から上方向にループして
長さ0の文字列でない場合、ループを抜ける
これをすれば、MaxRowは変わるはずですが？やっていますか？

MaxRow = Range("AC5").End(xlDown).Row
For i = MaxRow To 5 Step -1
If Range("AC" & i) <> "" Then Exit For
Next i
MaxRow = i

さて今回のご質問の場合、セル値連結のループの前にMaxRowまでのループが
存在しますから、そこでMaxRowを変更すれば、余計にループを回す必要性はありません

[24] mixiユーザー 09月01日 23:37

>>[18]
＞取り除く処理が書けませんが(笑)調べてみます。

データ値として","が登場しない事が前提となりますが、
文字列の末尾からループしながら1文字ずつチェックして、
文字列先頭から","以外の文字が登場した位置までを切り出せばOKです。

恐らくマリ男さんがおっしゃっているのは、
　・数式入力済の最終行まではEnd()でチェックできる
　・数式入力済だけれども値が空白の範囲は、
　　ループさせながら1行ずつチェックする必要がある
ので、この2つを併用して見た目上の非空白行を探す必要がある、
という事です。
あなたは前者の部分しかやっていないようなので、後者に相当する部分のコードは
どのようなものを記述したのか提示して欲しいという事なのだと思います。

[25] mixiユーザー 09月01日 23:44

>>[24]
フォローありがとうございます

ただ、この状況を見る限り、Danielさんが考えているとは
私は思えなくなっています
そのような様子が少なくとも私には見えません・・・

[26] mixiユーザー 09月01日 23:59

>>[23]
Minonさんの補足があっておっしゃるコードがなんなのか理解したわけですけど、確かに数式が入っているけど見た目空白になっているセルを判別するコードは書いてませんね。分かりませんでしたから。

余談ですが、今まで質問された方の誰もがエクセルのすべてを理解しているもしくは習得しているとは思わない方がいいと思いますよ。特に
>というより、しっかりと勉強し考えれば分かるはず
これまで質問してきたことが身になっていない証拠ではないでしょうか
この発言にはマリ男さんは注意するべきだと思いますよ。

身になってないとこのコミュでは新たな質問すら許されないということですかね。
様々な理由でこのコミュを利用されてる方がおられると思いますので個人の考え方を押し付けるのは良くないと思いますよ。
エクセルを習得するしないは個人の自由ですしね。

ところで教えていただいたコードはじっくり参考にさせていただきます。
ありがとうございます。

[27] mixiユーザー 09月02日 00:02

>>[24]
なるほど。右端からループで「,」を探して「,」以外の文字列が出てきたらそこまでを抜き出すのですね。
ループが多いと頭が混乱しますが考えてみます。ありがとうございます。

[28] mixiユーザー 09月02日 00:12

あそこまで説明して分からなかったから書いてない！？
それでは、無理でしょうね

習得するしないの問題ではなく、やる気の問題だと思いますね
やる気があるのであれば、ある情報が来ればそれを試してみる
ましてや、質問しているのであれば、それに対するレスポンスとして
このようなコードでこのような結果になったがどうすれば良いか？
などアドバイスを求めるものだと私は思います
分からないから早くコードを提示してくれ、というのは浅はかというか・・・

質問をするより遥かに自分で考えてコードを書いた方が
無駄に時間を使わなくて良いと思うのですがね・・・

実際私は最初の段階ではコードは書いていませんでした
私はこの程度であれば頭に浮かびますので
それをわざわざタイプすることをなぜ要求されなければならないのか
意味が分かりません
時間があいたときに書いたので実際のSheetで使えるものかは不明です

回答待ちの他力本願では自分が思ったようなものを作ることは
ほとんど不可能に近いのではないかと私は思います

[29] mixiユーザー 09月02日 00:20

>>[26]
>身になってないとこのコミュでは新たな質問すら許されないということですかね。
様々な理由でこのコミュを利用されてる方がおられると思いますので個人の考え方を押し付けるのは良くないと思いますよ。
エクセルを習得するしないは個人の自由ですしね。

他のほとんどの質問者の方は、もう少しやる気が感じられるので
ここまでは言いませんし、そう思うこともありません

ただ、あなたからはやる気が一切といって良いほど感じられませんでした
今まで質問を何度もしているのであるのであれば、そこから少しは
学ぶということをしてはいかがですか？していますか？
と言っているだけです

習得するしないは確かに個人の自由です
ただ、質問する以上、回答が来れば、それを考え試す
そして、完全にではなくとも、それを理解するよう努力する
それは最低限必要なことではないでしょうか？

[30] mixiユーザー 09月02日 00:42

>>[29]
>今まで質問を何度もしているのであるのであれば、そこから少しは
学ぶということをしてはいかがですか？していますか？
と言っているだけです

それはこのコミュで質問する上で必須ですか？しないといけないのですか？
それこそ個人の自由でしょ。
ま、私の場合応用力がないので同じような質問を繰り返してることはあると思いますが一応教えていただいたことは理解しようとしています。

>習得するしないは確かに個人の自由です
ただ、質問する以上、回答が来れば、それを考え試す
そして、完全にではなくとも、それを理解するよう努力する
それは最低限必要なことではないでしょうか？

習得を個人の自由と認めるのならその後のご指摘は矛盾してることをご理解してますか？
コミュの特性上文章のやり取りの中でことなのでそこまでいわれる筋合いはないかと思いますが、やる気が感じられる文章が書ければマリ男さんに嫌味を言われることなく質問が解決するのですね。そんな人の顔色伺いながら質問するなんて堅苦しいコミュにいつからなってしまったんでしょうね。

数式が分からない、どう考えていけばいいか分からない、なんてことExcelでは山ほどあると僕は思いますけどね。特に数学的なアプリケーションなので一つの解を導きだす方法はいろいろあるでしょうし、人それぞれ様々な視点から答えを導きだせるものでしょう。だからこそこういったExcelに精通されている方がいるSNSを利用する価値はあると思いますが。

次回質問させてもらう際はできるだけやる気がみえるように書き込むことにします。
長文失礼いたしました。

[31] mixiユーザー 09月02日 00:57

>>[30]
>習得を個人の自由と認めるのならその後のご指摘は矛盾してることをご理解してますか？
習得するのは自由と言いましたが、他力本願に努力をしなくて良い
とは言っていないはずですが
質問する以上、何をしたのかアクションを起こすべきだと思いますし
何をしたのか、その成果がどうであったのか、どういう問題があったのか
ということがないのは、それこそコミュニティなのですからどうなのでしょうか？

別に顔色を伺えとは言っていません、アドバイスに基づき
何を行ったのか、どうなったのかという報告はするべきだと言っているのです
そのような返信があれば、回答をする側の私としては
しっかりとアドバイスが伝わっているのか、伝わっていないのか
という判断も出来ますし、伝わっていなければ訂正することも出来ます
そして、それを実行してくれているということだけでも
私はその人のやる気を感じますし、そういった方はお手伝いしよう
という気持ちになります

今回のようにアドバイスをしても、理解できないからやらなかった
という状態では何をすることもできません
ピンと来ないなど抽象的な表現に頼り、どこが分からないのか
はっきりと伝わって来ない
しかも、ピンと来ないからといって、検証することもしていない
このような状態でどうしろというのでしょうか？

[32] mixiユーザー 09月03日 02:55

こんばんは。

Danielさん、ご質問された
> 「1/10,1/20 ○○病院,1/15 △△病院,1/21 □□病院,,,,」
> これを
> 「1/10,1/20 ○○病院,1/15 △△病院,1/21 □□病院」
> としたいです。
は解決されましたか？

[33] mixiユーザー 09月03日 16:58

>>[32]
マリ男さんに教えて頂いたコードを仕事が立て込んでてまだ未検証なんです。
問題の解決はまだです。。

[34] mixiユーザー 09月04日 12:57

皆さんへ。
マリ男さんに教えていただいたコードをMaxRowにすることで無事解決いたしました。

ありがとうございました。

[35] mixiユーザー 09月04日 13:47

良く考えれば、無駄にループを増やすことなく、既存のループ内で
同様の処理をさせれば解決すると思いますがね

[36] mixiユーザー 09月05日 09:13

>>[35]
そうなんですね。
それは私の場合、
----------------------
For i = 7 To MaxRow
HName = Cells(i, "AD")
Flag = True
----------------------
と
----------------------
Dstr = ""
For i = 0 To UBound(HN)
For j = 6 To MaxRow
If Cells(j, "AD") = HN(i) Then
Dstr = Dstr & "," & Format(Cells(j, "AC"), "m/d")
End If
Next
----------------------
にMaxRowとして最終行を使用していますが、両方に追記するといったような考えになるのでしょうか？
それとも、
----------------------
For i = 7 To MaxRow
HName = Cells(i, "AD")
Flag = True
----------------------
の部分に組み込むことで下に書いたMaxRowにも値は反映され、2度書かなくても（？）事足りるといったことですか？

[37] mixiユーザー 09月05日 10:55

>>[36]
コードがどういう動作をして、変数の値がどう変わるのか
考えたら分かるのでは？

というより、以前に私はほとんど答えと言って良いような
内容(どこで何をすれば良いのか)を書き込んだと思いますが？

[38] mixiユーザー 09月05日 11:48

>>[37]
へー

[39] mixiユーザー 09月05日 11:58

ぐだぐだやってないでさっさと手を動かして試せば良いのに
試してみれば良いことを試さずにいちいち他人を煩わせる感覚が理解できない。
マリ男さんがその事を指して「考えていない」というなら私も同感。

[40] mixiユーザー 09月05日 12:09

>>[38]
うん、やる気ないならやめたら？

前に何度か書き込んでいますから、それを読んでいれば
ヒントになるところは分かると思いますが？
それをしないようでは、理解すること考えることは不可能でしょうね
それでは「ピンとくる」訳がありません

[41] mixiユーザー 09月05日 12:19

無駄に思えるかも知れないけど、身に付ける過程ではある程度無駄を含む反復作業が必要です。

答えを自分で導き出せないのに答えを与えてもらってそれを眺めて理解した気になっても、
どこかである程度手を動かして定着させないとすぐに忘れますよ。
今こそ定着させるために色々試してみる良い機会だと思いませんか？

[42] mixiユーザー 09月05日 12:28

>>[41]
度々フォローありがとうございます

実際にやってみないと分からないこともありますし
何度も同じことを行って習得することになっていくのだと、私も思います

そして、ある程度定着したと思っても、少し時間が経つと
また忘れてしまうということはよくあることだと思うので
そうしたときも、以前にやっていたことを見直したり
実際に行ってみたりということは必要になってくる作業だと思いますね

[43] mixiユーザー 09月05日 13:15

とりあえず、炎上しそうなのでこのトピックへの書き込みはこれまでにしますが、教えていただいたことには感謝してます。
ただこちらとしてはエクセルの技術云々を向上したいからこちらに書き込んだ訳でも、今回の質問が業務成果としてどうしても解決しなければならない問題であったわけでもありません。

単純に仕事の効率化の為に質問をしただけで、皆さんに何も努力してないと言われようが特に気にもとめません。
こちらとしては既に構築したコードを提示し、問題点を解決したい内容も書き込んだつもりです。
それを考え方を提示しては頂きましたが、具体的に解決できるコードの具体例は自分で考えろってのはちょっと意地悪ではないですか？

教えていただいた考え方をコードにする技量のない方は質問するなというような約束事でもあるのでしょうか？
正直私はそのような技量を持ち合わせてませんし、今後もあえて習得しようとは思ってません。調べればわかることであれば調べますし、結果が同じであれば過程はある程度省略したいとも思ってます。

それをあたかも努力してないと勝手に判断し、人を批難する回答者様達にやる気がみせれるような返答を出来ると期待されても到底無理です。

やる気が見えないと感じる質問者にはそれ以上回答しなければ済む話ですよね。

こちらもわざわざ皆様にお願いに上がっているわけではないですし、わからないところや教えて欲しいところは素直に伝えてるつもりです。

今後はもう少し質問者と回答者が気持ちよくやり取りができるようなコミュであればと思います。

[44] mixiユーザー 09月05日 13:54

>>[43]
>
具体的に解決できるコードの具体例は自分で考えろってのはちょっと意地悪ではないですか？
ほぼ答えのヒントを出していることのどこが意地悪？

>正直私はそのような技量を持ち合わせてませんし、今後もあえて習得しようとは思ってません。調べればわかることであれば調べますし
であれば、御自分で調べられるレベルで行えば良いのでは？
調べるということと人に聞くということは必ずしも
一致するとは私には思えません

>それをあたかも努力してないと勝手に判断し
では、今回の質問をしてから何かしていましたか？
私にはそのような素振りは見えませんでしたが
前にも書いたように「ピンとこない」というようなことで
新たなコード作成もしていなかったように読み取れましたが？

ログインすると、残り5件のコメントが見れるよ