エクセル 複数セル 文字の統合

質問

エクセルで，次のような操作ができないかとご相談です。
セル　　A　　　B　　　　C　　　　D　　　　E　　　　　F　　　　結合セル
品名　りんご　みかん　　なし　　りんご　　みかん　　ぶどう　　りんご２，みかん２，なし，ぶどう

結合セルには，「＆」と”，”を使って「りんご，みかん，なし，りんご，みかん，ぶどう」とはできるのですが，重なりのある言葉に関しては，まとめて数字にできないかと思っております。
何かよいお知恵は無いでしょうか？ご教授いただければ助かります。

回答No.3

keithin · ベストアンサー

ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

public function CONCATENATECOUNT(Target as excel.range) as string
　dim h as range
　dim myDic as object
　dim o as variant
　dim res as string

　set mydic = createobject("Scripting.Dictionary")
　for each h in target
　　if h <> "" then
　　　mydic(h.value) = mydic(h.value) + 1
　　end if
　next

　for each o in mydic.keys
　　res = res & "," & o & iif(mydic(o) > 1, mydic(o), "")
　next

　concatenatecount = mid(res, 2, 999)
end function

ファイルメニューから終了してエクセルに戻る

ご質問で書かれている「セル」と「品名」というのがイミフメイなので無視することにして、Ａ１からＦ１までの各セルにりんごやぶどうと記入してあるとします
実際には勿論別にどこのセルでもかまいません。
「結合セル」に
=CONCATENATECOUNT(A1:F1)
のように、結合したい言葉を記入してあるセル範囲を指定して関数を記入します。

お礼

ご教授ありがとうございました！
わたしのやりたことそのものです。見事にカウントできました。
できれば，追加の質問にもお答えいただけるとありがたいです。
ありがとうございました！！

補足

ありがとうございます！！私のやりたことそのものができました。
追加で質問させていただいてよろしいですか？

　　A　　　　B　　　　C　　　　D　　　　　結合セル
りんご２　　なし　　りんご　　ぶどう　　りんご３，なし，ぶどう

といった結合は無理ですよね？
あつかましい質問でしみません。ご教授いただけますと助かります。

回答No.2

ryo_ky

結合セルにはおそらく=A1&","&B1&","&C1&","&D1&","&E1&","&F1と入力されているのではないかと思いますが、質問にあるようなものを作りためには工夫が必要です。
最初に言葉が重複しない表を作成します。作成方法は参照URLの方法をお試し下さい。

参照：http://www.eurus.dti.ne.jp/~yoneyama/Excel/jituyou/jyufuku.htm

表はA2から右方向に作成すれば、
　A2 　　B2　　 C2　　 D2
りんご　みかん　なし　ぶどう
となっているはずです。

その後は文字の数を数えるのにCOUNTIFを使えば文字数が求まります。数式をA3に入れれば
=COUNTIF($A1:$F1,A2)
となります。これを右方向にコピーします（D3までコピー）

この状態であれば
　 A　　　B　　　C　　　D
2 りんご　みかん　なし　ぶどう
3　　2　　　2　　　1　　　1
となっているはずです。
最後にIFを利用して数値が1の場合は空白、それ以外の場合は求めた数値を入れます。
結合セルには
=A2&IF(A3=1,"",A3)&","&B2&IF(B3=1,"",B3)&","&C2&IF(C3=1,"",C3)&","&D2&IF(D3=1,"",D3)
と入力すれば、りんご２，みかん２，なし，ぶどう
となります。

お礼

ご教授ありがとうございました！
実際にやってみましたら，見事にカウントできました。
別表を作ると，また便利になるということで，応用が効きそうです。
今回は別の方にベストアンサーを付けさせていただきますが，別の機会に，またこの方法を試させていただこうと思っています。
ありがとうございました！！

回答No.1

tom04

こんばんは！

表のレイアウトを工夫すれば関数でもできそうですが・・・
VBAでの一例です。

元データはSheet1のA列～F列の1行目からあり、H列以降に表示させるとします。
Sheet2を作業用のSheetとして使用していますので、
Sheet2は全く使用していない状態にしておいてください。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, endCol As Long, cnt As Long
Dim c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
endCol = wS1.UsedRange.Columns.Count
If endCol > 7 Then
Range(Columns(8), Columns(endCol)).ClearContents
End If
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To 6 '←Ａ列～Ｆ列まで
If wS1.Cells(i, j) <> "" Then
If WorksheetFunction.CountIf(wS2.Rows(i), wS1.Cells(i, j)) = 0 Then
cnt = cnt + 1
With wS2.Cells(i, cnt * 2 - 1)
.Value = wS1.Cells(i, j)
.Offset(, 1) = 1
End With
Else
Set c = wS2.Rows(i).Find(what:=wS1.Cells(i, j), LookIn:=xlValues, lookat:=xlWhole)
c.Offset(, 1) = c.Offset(, 1) + 1
End If
End If
Next j
cnt = 0
Next i
wS2.Range("A1").CurrentRegion.Copy wS1.Cells(1, "H")
wS2.Cells.Clear
wS1.Columns.AutoFit
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

お礼

ご教授ありがとうございました！
実際にやってみましたら，見事にカウントできました。
今回は別の方にベストアンサーを付けさせていただきますが，別の機会に，またこの方法を試させていただこうと思っています。
ありがとうございました！！