Excelで索引を作る際、重複項目とページ数を抽出したい

質問

副読本教材の索引を作っています。Excelに索引項目とページ数を入力しましたが、重複項目のページ数をつまみ上げる方法が分かりません。どなたか教えていただけませんでしょうか。

＜現在の状態＞
A列　　　　　　B列
（項目名）　　（ページ数）
北海道　　　　　4
北海道　　　　　10
北海道　　　　　19

＜したい状態＞
A列　　　　　　B列
（項目名）　　（ページ数）
北海道　　　　　4,10,19

どうかよろしくお願いします。

回答No.2

noname#204879 · ベストアンサー

Fig-1
　　　A　　　B　　 C　　　 D
1　 項目名　頁　 TMP　　ページ
2　 福島県　　1　 TRUE　1
3　 福島県　　7　 TRUE　1,7
4　 福島県　 15　 TRUE　1,7,15
5　 福島県　 20　FALSE　1,7,15,20
6　 北海道　　4　 TRUE　4
7　 北海道　 10　 TRUE　4,10
8　 北海道　 19　FALSE　4,10,19
9　 三重県　 15　FALSE　15
10　宮城県　　6　 TRUE　6
11　宮城県　100　FALSE　6,100

Fig-1 において、セル C2、D2 に次式を入力して、範囲 C2:D2 を下方にズズーッと複写。
　　C2: =A2=A3
　　D2: =IF(A2=A1,D1&","&B2,B2&"")
列Ｃ、Ｄを選択して[コピー]→[値の貼り付け]を実行。
[オートフィルタ]でＣ列の TRUE だけを抽出して Fig-2 を得る。

Fig-2
　　　A　　　B　　 C　　　 D
1　 項目名　頁　 TMP　　ページ
2　 福島県　　1　 TRUE　1
3　 福島県　　7　 TRUE　1,7
4　 福島県　 15　 TRUE　1,7,15
6　 北海道　　4　 TRUE　4
7　 北海道　 10　 TRUE　4,10
10　宮城県　　6　 TRUE　6

左端枠上の行番号 2 をクリックした後、Ctrl+Shift+↓ をパシーッと叩いて、[編集]→[行の削除]を実行。
[オートフィルタ]を解除した状態が Fig-3

Fig-3
　　　A　　　B　　 C　　　 D
1　 項目名　頁　 TMP　　ページ
2　 福島県　 20　FALSE　1,7,15,20
3　 北海道　 19　FALSE　4,10,19
4　 三重県　 15　FALSE　15
5　 宮城県　100　FALSE　6,100

列Ｂ、Ｃを削除して Fig-4 を得る。ヤレヤレですゥ～(^_^)

Fig-4
　　　A　　　　B
1　 項目名　ページ
2　 福島県　1,7,15,20
3　 北海道　4,10,19
4　 三重県　15
5　 宮城県　6,100

お礼

どうも有難うございました。とても分かりやすく、こちらで出来ました！
大変助かりました。

補足

もう一つ追加の質問で申し訳ございませんが、太字の数字が混ざってくるとどうなるのでしょうか。（図版付きの解説がある項目頁は太字になっています）

（現在の状態）
A列　　　　　　B列
（項目名）　　（ページ数）
北海道　　　　　4
北海道　　　　　10（太字）
北海道　　　　　19

＜したい状態＞
A列　　　　　　B列
（項目名）　　（ページ数）
北海道　　　　　4,10（太字）,19

もし、お分かりのようでしたら、お教え頂ければ助かります。
ひとつずつ手で太字に直していくとミスしそうなので。。

回答No.5

imogasi

例データ　Sheet1
A1:B11
項目 ページ
a 1
b 2
a 4
d 5
c 6
a 7
b 7
d 8
c 6
a 7
結果　Sheet2　
項目
a 1,4,7,7
b 2,7
d 5,8
c 6,6
コード（VBEの標準モジュールに貼り付けて実行）
Sub test01()
Dim r As Range
k = 1 'アウトプットシート・スタート行
Dim sh1 As Worksheet
Dim sh2 As Worksheet 'アウトプットシート
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
For i = 1 To sh1.Range("A65536").End(xlUp).Row
Set r = sh2.Range(sh2.Cells(1, 1), sh2.Cells(k, "A")).Find(what:=sh1.Cells(i, "A"))
If TypeName(r) = "Nothing" Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
k = k + 1
Else
sh2.Cells(r.Row, "b") = sh2.Cells(r.Row, "b") & "," & sh1.Cells(i, "B")
End If
Next i

End Sub
上記ロジックは
Sheet1のA列の項目をを、Sheet2のA列に置いて検索して
見つかったらページをSheet2の見つかった行に、文字列に追加
見つからなければ、項目とページを最後の次ぎの行に追加

お礼

遅くなり申し訳ございません。どうも有難うございました。いろいろやり方があるんですね。今度試したいと思います。

回答No.4

ham_kamo

私もマクロを組んでみました。
Ｃ列、Ｄ列の１行目に（項目名）、（ページ数）というタイトルが入っているとして、Ｃ列、Ｄ列に索引を作成します。

Alt+F11でVBAの画面を開き、下のマクロを貼り付けてF5で実行してみてください。

Sub 索引作成()
　　Dim R As Range, R2 As Range, LastFound As Range
　　Dim Found As Boolean
　　Range("C2", Range("D65536").End(xlUp).Offset(1, 0)).Clear
　　For Each R In Range("A2", Range("A65536").End(xlUp))
　　　　Found = False
　　　　Set LastFound = Range("C65536").End(xlUp)
　　　　For Each R2 In Range("C2", LastFound)
　　　　　　If R2.Value = R.Value Then
　　　　　　　　R2.Offset(0, 1).Value = R2.Offset(0, 1).Value & "," & R.Offset(0, 1).Value
　　　　　　　　Found = True
　　　　　　End If
　　　　Next
　　　　If Found = False Then
　　　　　　LastFound.Offset(1, 0) = R.Value
　　　　　　LastFound.Offset(1, 1) = R.Offset(0, 1).Value
　　　　End If
　　Next
End Sub

お礼

マクロを使ったことはほとんどありませんでしたが、
こちらで出来ました。

＞Ｃ列、Ｄ列の１行目に

これはA列、B列の間違いですね。これに気づかなかったので
最初は出来ませんでしたが、おかげさまで簡単に出来ました。
有難うございました。

回答No.3

zap35

以下の表があるとします
　　　　　Ａ列　　　　Ｂ列
１行目　都道府県　ページ
２行目　北海道　　　1
３行目　青森　　　　2
４行目　北海道　　　3
５行目　秋田　　　　5
６行目　青森　　　　6
７行目　岩手　　　　8

Ａ列にオートフィルタを設定後、Ａ列を選択し「データ」→「フィルタ」→「フィルタオプションの設定」を選択し「重複するレコードは無視する」にチェックをつけ「ＯＫ」で重複なしのリストが得られます。
この都道府県のリストをコピーして別シートのＡ１以下に貼り付け。

貼り付けたシートのＢ２の式は
=IF(COUNTIF(Sheet1!$A$1:$A$7,$A1)>=COLUMN()-1,INDEX(Sheet1!$B$1:$B$7,SUMPRODUCT(LARGE((Sheet1!$A$1:$A$7=$A1)*ROW(Sheet1!$A$1:$A$7),COUNTIF(Sheet1!$A$1:$A$7,$A1)-COLUMN()+2))),"")
このセルを下方向、および右方向にコピーします。すると
　　　　　Ａ列　　　Ｂ列　　　Ｃ列
１行目　北海道　　　1　　　　3
２行目　青森　　　　2　　　　6
３行目　秋田　　　　5　
４行目　岩手　　　　8
という表が作成されます。

十分に右側の列に（仮にＧ列とします）
=B1&","&C1&","&D1&","&E1
の式を入れてページ数を連結します。このセルは後で「コピー」→「編集」→「形式を選択して貼り付け」→「値」で文字列データに変換します。ここまでで「1,3,,」という文字列が得られます。

最後に末尾の「，」を削除します
=LEFT(G1,SUMPRODUCT(LEN(B1:E1))+SUMPRODUCT(LEN(B1:E1))-1)

やってみたけどマクロの方が簡単だったかもｗ

お礼

有難うございました。ちょっと手順がかかるようですが、マクロ恐怖症の私には、やりやすい方法かも知れません。こちらも今度試してみます。どうも有難うございました。

回答No.1

Ce_faci

こんばんわ
どうしても１行にしたいということでしょうか？
つまり、オートフィルタではないということでしょうか？

関数で考えるより、マクロの方が早そうです。
現状の状態にて、セルＡ３に”項目名”と入れてＡ４以降に北海道なりロシアなり入れるものとします。

求めたい項目をセルＡ１に入力します。結果はＢ１です。
あとはマクロの実行です。
以下マクロです。

Sub 頁抽出()
Dim R As Range
Dim I As Long
Dim v As Variant
Dim j As Variant
Dim p As Variant

Sheets(1).Cells(1, 2).Value = ""
v = Sheets(1).Cells(1, 1).Value
I = 4

For Each R In Range("A:A")
Set R = Sheets(1).Cells(I, 1)
j = Sheets(1).Cells(I, 2).Value
If R.Value = "" Then
Exit For
ElseIf R.Value = v Then
p = Sheets(1).Cells(1, 2).Value
Sheets(1).Cells(1, 2).Value = p & Chr(44) & j
End If
I = I + 1
Next
Sheets(1).Cells(1, 2).Value = Right(Sheets(1).Cells(1, 2).Value, Len(Sheets(1).Cells(1, 2).Value) - 1)
End Sub

お礼

有難うございました。私の質問の仕方がわるく申し訳ありません。

＞現状の状態にて、セルＡ３に”項目名”と入れてＡ４以降に北海道なりロシアなり入れるものとします。
＞求めたい項目をセルＡ１に入力します。結果はＢ１です。
あとはマクロの実行です。

ちょっと上記のセルの入れ方の部分がイメージできませんでしたが、どうも有難うございました。