[[20200813201758]]　『同じ番号をまとめたい』（秋枚）　ページの最後に飛ぶ

『同じ番号をまとめたい』（秋枚）

エクセルで教えてください。

生物の種類をまとめる表を作っています。

Ｂ列に番号(1、2、3、4、、、
C列に生物名
Ｆ列に同じ種類の一番若いデータ番号が入っています。

Ｂ列-C列-Ｆ列
1-あさり-1
2-クモ-2
3-しじみ-1
4-こおろぎ-2
5-はまぐり-1
6-鮭-6
7-鰤-6

これをH列に纏めたいのですが、関数や機能でパッと出せますか？

Ｂ列-C列-Ｆ列-H列
1-あさり-1-1/3/5
2-クモ-2-2/4
3-しじみ-1-1/3/5
4-こおろぎ-2-2/4
5-はまぐり-1-1/3/5
6-鮭-6-6/7
7-鰤-6-6/7

行が800行くらいあって同じ種類になるのは多くて20行くらいです。

よろしくお願いします。

＜使用 Excel：Excel2007、使用 OS：Windows8 ＞

 >関数や機能でパッと出せますか？
 出せません。なぜならH列に入っている内容について説明がないからです。
 貴方は分かっていても回答者には分かりません。
（SOH） 2020/08/13(木) 21:53

H列の説明分かりずらくてすいません。
Ｆ列の1行目にあさりの種類が貝として初めて出てくる種類なので番号1が入力されています。
3行目と5行目も貝なのでＦ列には1と入力されています。
H列には1行目と3行目と5行目に同じ「1/3/5」が表示されるようにしたいのです。
他の行も初めて出てくる種類の番号を以下行に入力されているのでH列には同じように「/」で区切った番号を表示させたいです。
（秋枚） 2020/08/13(木) 22:09

 こんばんは　＾＾
あのぉ～区切り文字は「/」でなければいけないのでしょうか？？；
理由。。。エクセル様が日付と勘違いして書式を自動変更する、とか
割り算してしまうとか。。無きにしも有らずかと思います。どうして
もという事でしたら、一工夫必要ですが出来ない事はないかと。。。
私の場合、マクロですが。。。m(_ _)m
（隠居じーさん） 2020/08/13(木) 22:42

 新規ブックをIJ00087.xlsmで保存して
Sheet1
に情報をB1,C1,F1からコピペしてお試しを
エラー処理は御座いません。あってるかなぁ～。。。＾＾；自信ありません。。。
Option Explicit
Sub OneInstanceMain()
    Const zProgramID As String = "IJ00087.xlsm"
    Dim zTb As Workbook
    Dim i As Long
    Dim n As Long
    Dim v() As Variant
    Dim v2() As Variant
    Dim v3() As Variant
    Dim t As Double
    Dim zD As Object
    t = Timer
    Set zTb = Workbooks(zProgramID)
    Set zD = CreateObject("Scripting.Dictionary")
    With zTb.Worksheets("Sheet1")
        v = Intersect(.UsedRange, .Range("B:F")).Value
    End With
    ReDim v2(1 To UBound(v, 1), 1 To 1)
    For i = 1 To UBound(v, 1)
        zD(v(i, 5)) = zD(v(i, 5)) & v(i, 1) & ","
    Next
    v3 = zD.keys
    For i = 1 To UBound(v, 1)
        n = Application.Match(v(i, 5), v3, 0) - 1
        v2(i, 1) = Left(zD(v3(n)), Len(zD(v3(n))) - 1)
    Next
    With zTb.Worksheets("Sheet1")
        Intersect(.UsedRange, .Columns(8)).Clear
        .Cells(1, 8).Resize(UBound(v2, 1), 1) = v2
    End With
    Erase v, v2, v3
    Set zD = Nothing
    Set zTb = Nothing
    MsgBox "終了　" & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - t) - Int(Timer - t), ".000") & " 秒"
End Sub
（隠居じーさん） 2020/08/13(木) 22:50

隠居じーさん、さん
お返事ありがとうございます。

マクロ？を使った事ないのでネットで調べながら試してみます。

／じゃなくても大丈夫です。
区切りとして、でも。でも-でもなんでも大丈夫です。

一点、種類分けできない生物を✖にしているのですが、それは空白のままにしておくことはできますでしょうか？

よろしくお願いします。
（秋枚） 2020/08/14(金) 09:52

行は800という前提で回答します。800ではないのであれば、関数の800の部分を変更してください。

=TEXTJOIN("/",TRUE,IF($F$1:$F$800=F1,$B$1:$B$800,""))

入力後、確定させる際はShift+Ctrl+Enterとしてください。
（DS） 2020/08/14(金) 10:00

追記があったようなので、修正します。
（できれば、達成したい内容は最初から明確に記載されるのが、
　解決の近道だと思います）

H1への入力
=TEXTJOIN("/",TRUE,IF(($F$1:$F$800=F1)*(F1<>"✖"),$B$1:$B$800,""))

Shift+Ctrl+Enterで確定後、最終行までコピー。

区切り文字は"/"の部分を変更して指定してください。"-"、","等。
タイトル行等があるようならば、範囲を修正してください。

（DS） 2020/08/14(金) 10:08

 おはようございます　＾＾
✖の件は、現状多分、そぉなっていると思います。
いい加減なコードですので、ご参考程度にお止め
下さいませ。m(_ _)m
（隠居じーさん） 2020/08/14(金) 10:19

 おはようございます　＾＾
すみません　↑　なっていませんね。申し分けありません。
後ほど、修正、アップしておきます、暫し御猶予を。。。
＾＾；。。。m(_ _)m
（隠居じーさん） 2020/08/14(金) 10:30

 こんにちは　＾＾
お待たせいたしました。当方のテスト情報と結果［H列］です
Sheet1
    |[A]|[B]|[C]     |[D]|[E]|[F]|[G]|[H]  
 [1]|   |  1|あさり  |   |   |  1|   |1,3,5
 [2]|   |  2|クモ    |   |   |  2|   |  2,4
 [3]|   |  3|しじみ  |   |   |  1|   |1,3,5
 [4]|   |  4|こおろぎ|   |   |  2|   |  2,4
 [5]|   |  5|はまぐり|   |   |  1|   |1,3,5
 [6]|   |  6|鮭      |   |   |  6|   |6,7,9
 [7]|   |  7|鰤      |   |   |  6|   |6,7,9
 [8]|   |  8|ととろ  |   |   |✖ |   |     
 [9]|   |  9|いかなご|   |   |  6|   |6,7,9
修正コード
Option Explicit
Sub OneInstanceMain()
    Const zProgramID As String = "IJ00087.xlsm"
    Dim zTb As Workbook
    Dim i As Long
    Dim n As Long
    Dim v() As Variant
    Dim v2() As Variant
    Dim v3() As Variant
    Dim t As Double
    Dim zD As Object
    t = Timer
    Set zTb = Workbooks(zProgramID)
    Set zD = CreateObject("Scripting.Dictionary")
    With zTb.Worksheets("Sheet1")
        v = Intersect(.UsedRange, .Range("B:F")).Value
    End With
    ReDim v2(1 To UBound(v, 1), 1 To 1)
    For i = 1 To UBound(v, 1)
        If Not v(i, 5) = ChrW(10006) Then
            zD(v(i, 5)) = zD(v(i, 5)) & v(i, 1) & ","
        End If
    Next
    v3 = zD.keys
    For i = 1 To UBound(v, 1)
        If Not v(i, 5) = ChrW(10006) Then
            n = Application.Match(v(i, 5), v3, 0) - 1
            v2(i, 1) = Left(zD(v3(n)), Len(zD(v3(n))) - 1)
        End If
    Next
    With zTb.Worksheets("Sheet1")
        .Columns(8).Clear
        .Cells(1, 8).Resize(UBound(v2, 1), 1) = v2
    End With
    Erase v, v2, v3
    Set zD = Nothing
    Set zTb = Nothing
    MsgBox "終了　" & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - t) - Int(Timer - t), ".000") & " 秒"
End Sub
（隠居じーさん） 2020/08/14(金) 11:09

ユーザー定義関数です

　=concatif($F$1:$F$800,F1,$B$1:$B$800)

 Function concatif(検索範囲 As Range, 検索条件 As Range, 結合範囲 As Range) As String
    Dim k As Long

    With CreateObject("system.collections.arraylist")
        For k = 1 To 検索範囲.Count
            If 検索範囲(k).Value = 検索条件 Then .Add 結合範囲(k).Value
        Next
        concatif = Join(.toarray, "／")
    End With

 End Function

（マナ） 2020/08/14(金) 11:18

お二人ともありがとうございます。
お返事遅くなってすいません。

どちらの方法でも事ができました。
感謝です。
（秋枚） 2020/08/19(水) 12:28

コメント返信：

[ 一覧(最新更新順) ]

[[20200813201758]] 『同じ番号をまとめたい』（秋枚） ページの最後に飛ぶ

[[20200813201758]]　『同じ番号をまとめたい』（秋枚）　ページの最後に飛ぶ