[[20211216215020]] 『重複削除して、文字を繋げたい』(このみ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『重複削除して、文字を繋げたい』(このみ)

教えて下さい。
マクロでも関数でも良いのですが、分かる方がいらっしゃいましたら教えて下さい。
  A

  2  犬
  3  猫
  4  鳥
  5  海猫
  6  鳥

とセルに文字が入っています。
それを、C2セルに、
犬、猫、鳥、海猫のように、重複を削除して文字を繋げたいのです。

=TEXTJOIN(", ", TRUE, IF(MATCH(A2:A6, A2:A6, 0)=MATCH(ROW(A2:A6), ROW(A2:A6)), A2:A6, ""))

上記で出来たのですが、6行目まででなく、10行目までかもしれないし、20行目までかもしれない、、のように、最終行を可変にしたいのですが、
式の範囲を多めにA2:A50とかにしてみたら、エラーになってしまいます。
何か良い方法ありますでしょうか?

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 以下の様に、A1に見出しとして「種類」とあると仮定して
    |[A] |[B]|[C]          
 [1]|種類|   |             
 [2]|犬  |   |犬,猫,鳥,海猫
 [3]|猫  |   |             
 [4]|鳥  |   |             
 [5]|海猫|   |             
 [6]|鳥  |   | 

 Sub Macro()
    Dim arr
    With Cells(1, 3)
        .Value = "種類"
        Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _
            xlFilterCopy, .Cells, .Cells, True
        arr = Range(Cells(2, 3), Cells(Rows.Count, 3).End(xlUp)).Value
        .CurrentRegion.Clear
        Cells(2, 3).Value = Join(WorksheetFunction.Transpose(arr), ",")
    End With
 End Sub          
(笊) 2021/12/16(木) 22:25

 マクロですが
 Sub Test()
    Dim c As Range, v As Variant
    With CreateObject("System.Collections.ArrayList")
        For Each c In Range("A2", Cells(Rows.Count, "A").End(xlUp))
            'Cの値が格納されていなければ格納
            If Not .Contains(c.Value) Then .Add c.Value
        Next
        '一次元配列に出力
        v = .Toarray
    End With
    '配列v内を"、"で接続
    Range("C2").Value = Join(v, "、")
 End Sub

(ピンク) 2021/12/16(木) 22:33


 IFERRORでエラーを回避すればいいのでは。

 =TEXTJOIN(", ", TRUE, IF(IFERROR(MATCH(A2:A50, A2:A50, 0),0)=MATCH(ROW(A2:A50), ROW(A2:A50)), A2:A50, ""))

(hatena) 2021/12/16(木) 22:56


 バージョンは確かに2016だろうか?
 TEXTJOIN関数が使えるということは365ではないだろうか?
 もし365であれば
 =TEXTJOIN(",",TRUE,UNIQUE(FILTER(A2:A50,A2:A50<>"")))
 ではどうだろうか?
(ねむねむ) 2021/12/16(木) 23:13

ユーザー定義関数にしました
 C2: =UniqueList(A2:A100)

 Function UniqueList(r As Range, Optional delim As String = "、") As String
    Dim c As Range

    With CreateObject("scripting.dictionary")
        For Each c In r
            If c.Value <> "" Then .Item(c.Value) = True
        Next
    UniqueList = Join(.keys, delim)
    End With
 End Function

(マナ) 2021/12/16(木) 23:28


 すまない、空白セルはTEXTJOIN関数の方で対応できるのでFILTER関数はいらなかった。
 =TEXTJOIN(",",TRUE,UNIQUE(A2:A50))
(ねむねむ) 2021/12/16(木) 23:35

 衝突したけどせっかく書いたので。

 2016でも使える場合と、使えない場合があるようです。
 下記のよると法人契約の場合は使えるらしい。

 https://answers.microsoft.com/ja-jp/msoffice/forum/all/excel2016%E3%81%AB%E3%81%8A%E3%81%84%E3%81%A6textj/209d997a-48fb-4afd-80dd-be2359fa663e?auth=1

 365なら、下記でも大丈夫のようですね。

 =TEXTJOIN(",",TRUE,UNIQUE(A2:A50))

 TEXTJOINの第2引数でTRUEにすることで空白を除去してくれるので。
(hatena) 2021/12/16(木) 23:44

皆様
色々と情報ありがとうございます。
返信遅くなり申し訳ありません。
家だとTEXTJOINを使うとエラーになり、会社PCだと使えたのですが、
法人契約否かが関係していたのですね。
色々な考え方のヒントや、新しい関数、マクロを教えて頂き、大変勉強になりました。
ありがとうございました。
(このみ) 2021/12/17(金) 04:59

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.