[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じ番号をまとめたい』(秋枚)
エクセルで教えてください。
生物の種類をまとめる表を作っています。
B列に番号(1、2、3、4、、、
C列に生物名
F列に同じ種類の一番若いデータ番号が入っています。
B列-C列-F列
1-あさり-1
2-クモ-2
3-しじみ-1
4-こおろぎ-2
5-はまぐり-1
6-鮭-6
7-鰤-6
これをH列に纏めたいのですが、関数や機能でパッと出せますか?
B列-C列-F列-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
こんばんは ^^ あのぉ〜区切り文字は「/」でなければいけないのでしょうか??; 理由。。。エクセル様が日付と勘違いして書式を自動変更する、とか 割り算してしまうとか。。無きにしも有らずかと思います。どうして もという事でしたら、一工夫必要ですが出来ない事はないかと。。。 私の場合、マクロですが。。。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
=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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.