エクセル計算式で複数セルの文字列を１つのセルに結合し、変換して、間にドットを入れる

エクセル計算式を教えてください。

（A）は変換する文字列の対応表
（B）は変換する元データ（A～G列まで。3行だけ載せました。空欄や変換しない文字列が入っていることもあります。）
（C）は変換した結果（A列だけ。3行だけ載せました。間にドットが入っています。）
です。

（A）（B）（C）それぞれ別のシートでも変換できる計算式がいいです。
どうかよろしくお願いいたします。

No.4 ベストアンサー 回答者： fujillin 回答日時： 2018/05/18 12:57

こんにちは

最近のTEXTJOIN関数などが使えるエクセルのバージョンなら、関数でも可能かと思いますが、私の環境では使えないので・・・

＞それぞれ別のシートでも変換できる計算式がいいです。
とのことですので、ユーザ定義関数にして、表の位置は引数で指定するように考えました。

ご質問文をよく見ると、結果の順序は表(A)の順序で、(B)の順序ではないのですね。
（先に、勘違いして（B)表の順のものを作ってしまいました(笑））

以下の内容として解釈しています。
　・結果の文字列は（A)表の順序で連結する
　・（A）表に無い値が（B）表に存在しても無視をする

使い方の例として、結果を表示したいセルに
　=transJoin(「表(A)のセル範囲」,　「表(B)の対象行の開始セル(範囲)」)
のようにして利用します。

第一引数は(A)の表に該当し、2列以上のセル範囲である必要があります。
第二引数は(B)のスタートセル（または範囲）を示します。
第二引数で指定されたセル（範囲）の行の右側にあるセル全部を対象としますので、単独セルでもセル範囲でも同じ結果にはなりますが、行内の値を変更した際に自動計算が働くためにはセル範囲で対象となるセルを包含するように指定しておく必要があります。

最初に、以下のユーザ定義関数を標準モジュールに設定しておきます。
Function transJoin(ByRef tbl As Range, ByRef target As Range) As String
　Dim t As Range, r As Range
　Dim maxc As Long, s As String

　Set t = target.Cells(1, 1)
　maxc = t.Worksheet.Cells(t.Row, Columns.Count).End(xlToLeft).Column
　If maxc > t.Column Then Set t = t.Resize(1, maxc - t.Column + 1)

　For Each r In tbl.Columns(1).Cells
　　If Not t.Find(What:=r, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
　　　s = s & "." & r.Offset(0, 1).Value
　　End If
　Next r
　transJoin = Mid(s, 2)
End Function

添付図のサンプルでは、B15セルに
　=transJoin($A$2:$B$6,B10:Z10)
の式を入力して、下方にフィルコピーしています。
（「B10:Z10」の部分は上記説明のように、「B10」だけでも同じ結果にはなりますが、仮にD10セルの値を変更しても連動しません。「B10:Z10」や「B10:H10」のような範囲を入れておけば、連動することが可能です。）

表(A)や表(B)が別シートにある場合でも、正しくセル範囲の指定を行うことで、同様の結果を得ることができます。

この回答へのお礼

TEXTJOIN関数など新しい関数があることを知りませんでした。ありがとうございます。
　・結果の文字列は（A)表の順序で連結する
　・（A）表に無い値が（B）表に存在しても無視をする
上記解釈そのとおりです。失礼いたしました。
VBAの利用を考えてみます。
ご丁寧な解説、痛み入ります。

お礼日時：2018/05/18 21:48

No.3 回答者： d-q-t-p 回答日時： 2018/05/18 09:50

何でも数式でやりたがる人は Googleスプレッドシートに移行した方が

いいと思います。

=SUBSTITUTE(TRIM(JOIN(" ",ARRAYFORMULA(IFERROR(TEXT(VLOOKUP(B10:H10,A$2:B$6,2,FALSE),"00000"),""))))," ",".")

で済むので。

この回答へのお礼

Googleスプレッドシートは存在は知ってましたが、詳しく知りませんでした。実現可能とは驚きです。勉強の価値ありそうです。参考になりました。ありがとうございます。

お礼日時：2018/05/18 10:10

No.2 回答者： tom04 回答日時： 2018/05/17 22:50

こんばんは！

（C）は1セル内に納めないといけないのでしょうか？
その場合は関数で！となるとかなり厄介なので、VBAでの一例です。
↓の画像で上の左側が（A）Sheet1、下側が（B）Sheet2、上の右側が（C）Sheet3としています。

標準モジュールにしてください。

Sub Sample1() '//この行から//
Dim i As Long, j As Long, k As Long
Dim cnt As Long, lastRow As Long, maxRow As Long, maxCol As Long
Dim myStr As String, c As Range
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
maxRow = wS2.UsedRange.Rows.Count
maxCol = wS2.UsedRange.Columns.Count
Application.ScreenUpdating = False
With Worksheets("Sheet3")
.Cells.ClearContents
.Range("B:B").NumberFormatLocal = "@"
For i = 1 To maxRow
For j = 1 To maxCol
If wS2.Cells(i, j) <> "" Then
Set c = wS1.Range("A:A").Find(what:=wS2.Cells(i, j), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
cnt = cnt + 1
.Cells(cnt, "B") = Format(c.Offset(, 1), "00000")
End If
End If
Next j
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 0 Then
.Range("B:B").Sort key1:=.Range("B1"), order1:=xlAscending, Header:=xlNo
For k = 1 To lastRow
myStr = myStr & .Cells(k, "B") & ","
Next k
.Cells(i, "A") = Left(myStr, Len(myStr) - 1)
.Range("B:B").ClearContents
cnt = 0
myStr = ""
End If
Next i
.Range("A:A").Columns.AutoFit
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub '//この行まで//

上記マクロを実行すると画像のような感じになります。
※　コード内のシート名は実情に合わせてください。

※　関数でないので、データ変更があるたびに
マクロを実行する必要があります。m(_ _)m

この回答へのお礼

関数ではやっかい、とのこと、それだけ確認できただけでも勉強になります。VBA利用を考えてみます。ありがとうございます。

お礼日時：2018/05/18 10:08

No.1 回答者： freeforvirus 回答日時： 2018/05/17 21:38

find, index, match 関数でしょう

この回答へのお礼

早速にご回答ありがとうございます。
勉強になります。調べてみます。

お礼日時：2018/05/18 10:05