[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索条件があいまいなリストの抽出』（天津風）
Aのリストと、Ｂのリストがあり、
Aのリストには名前が記載されています。
Bのリストには、検索したい人物名が部分的に記載されているリストがあります（正確なフルネームの抽出は不可能。苗字しかわかりません）
Aのリストの中から、Bのリストに登録されていない人物名を抽出したいのですが、どのようにしたら抽出できますでしょうか。
同じ苗字は検索対象外とします
（例のリストでいうと、Bリストに「佐藤」がありますが、Aリストの「佐藤ＡＡ」と「佐藤ＡＣ」は登録されているとみなしたいです。）
（Aのリストに「長谷川KK」がありますが、Bのリストに「長谷川」がありません。このようなデータだけ抽出したいです）
Ａのリスト
佐藤AA
佐藤AC
山田BBB
佐々木ＣＣ
橋本AA
石田AD
長谷川KK
田中AB
小田川NS
藤原AS
藤原AA
（以下400ぐらいデータが入っています）
Bのリスト
佐藤
山田
佐々木
石田
藤原
鈴木
小田川
藤原
（以下略、60件ぐらいデータが入っています。）
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
BのリストがＡのリストにあるかないかをみるだけでは？
（文字認識） 2022/09/05(月) 17:13
以下でどうでしょうか？ A列に元リスト、D列に検索リスト（100行と仮定）があるものとしています。 B列に「含む/含まない」の作業列、結果はF列に表示しています。
__A_______ __B__________ __C __D_______ __E __F___________
1 元リスト 含む/含まない 検索リスト 含まないリスト
2 佐藤AA TRUE 佐藤 橋本AA
3 佐藤AC TRUE 山田 長谷川KK
4 山田BBB TRUE 佐々木 田中AB
5 佐々木ＣＣ TRUE 石田
6 橋本AA FALSE 藤原
7 石田AD TRUE 鈴木
8 長谷川KK FALSE 小田川
9 田中AB FALSE 藤原
10 小田川NS TRUE
11 藤原AS TRUE
12 藤原AA TRUE
[B2] =ISNUMBER(LOOKUP(1,0/(FIND(FILTER($D$2:$D$100,$D$2:$D$100<>""),A2)))) ↓にコピ- [F2] =FILTER(A:A,(B:B=FALSE)*(B:B<>"")) （まる） 2022/09/05(月) 18:46
クエリ：Bのリスト
let
ソース = Excel.CurrentWorkbook(){[Name="Bのリスト"]}[Content],
変更された型 = Table.TransformColumnTypes(ソース,{{"Bのリスト", type text}})
in
変更された型
クエリ：AからB以外を抽出
let
ソース = Excel.CurrentWorkbook(){[Name="Aのリスト"]}[Content],
変更された型 = Table.TransformColumnTypes(ソース,{{"Aのリスト", type text}}),
追加されたカスタム = Table.AddColumn(変更された型, "カスタム", each Bのリスト),
#"展開された カスタム" = Table.ExpandTableColumn(追加されたカスタム, "カスタム", {"Bのリスト"}, {"Bのリスト"}),
追加された条件列 = Table.AddColumn(#"展開された カスタム", "カスタム", each if Text.StartsWith([Aのリスト], [Bのリスト]) then 1 else null),
グループ化された行 = Table.Group(追加された条件列, {"Aのリスト"}, {{"一致数", each List.Sum([カスタム]), type nullable number}}),
フィルターされた行 = Table.SelectRows(グループ化された行, each ([一致数] = null)),
削除された列 = Table.RemoveColumns(フィルターされた行,{"一致数"}),
#"名前が変更された列 " = Table.RenameColumns(削除された列,{{"Aのリスト", "AからB以外を抽出"}})
in
#"名前が変更された列 "
（マナ） 2022/09/06(火) 13:13
Option Explicit
Sub oNeInstance01()
Dim i&, j&, k&, v(), w(), x(), z(), ex, n&, eTx$, res As Boolean
Set ex = CreateObject("VBScript.RegExp")
ex.Global = True
With Worksheets("Sheet1")
v = .Cells(1, 1).CurrentRegion.Value
w = .Cells(1, 4).CurrentRegion.Value
ReDim x(1 To UBound(v, 1), 1 To 1)
For i = 1 To UBound(v)
For j = 1 To UBound(w)
eTx = ".*" & w(j, 1) & ".*"
ex.Pattern = eTx
res = ex.test(v(i, 1))
If res Then
For k = LBound(x) To UBound(x)
If x(i, 1) = Empty Then
x(i, 1) = 1
End If
Next
End If
res = False
Next
Next
ReDim z(0)
For i = 1 To UBound(x, 1)
If x(i, 1) <> 1 Then
z(UBound(z)) = v(i, 1)
ReDim Preserve z(UBound(z) + 1)
End If
Next
MsgBox Join(z, Chr(13))
End With
Erase v, w, x, z
（隠居Z） 2022/09/06(火) 21:58
トピ主さんからの返信がありませんが きっと既に…関数でされたい事は、実現できたのでしょう。^^
もし関数で出来ていないのなら、VBAの初期設定だけなら 誰でも簡単に…1時間もあれば出来ますので、その時はご連絡を お待ち致します。
では、場所をお借りして…VBAで久しぶりの「 Like演算子とワイルドカード 」 のお勉強です。( お忙しい方は、スルーしてください。)
◇結果 ( 抽出したいシート )
|[A]
[1]|橋本AA
[2]|長谷川KK
[3]|田中AB
Sub Search_Sample()
Dim ws(1 To 3) As Worksheet
Dim MyRNG As Range
Dim DataList As String
Dim i As Long, q As Long, cnt As Long, LastRow As Long
Set ws(1) = Sheets(1) '' Aのリストシート"
Set ws(2) = Sheets(2) '' Bのリストシート"
Set ws(3) = Sheets(3) '' 抽出シート"
LastRow = ws(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ws(2).Cells(Rows.Count, 1).End(xlUp).Row
DataList = ws(2).Cells(i, 1).Value
For q = 1 To ws(1).Range("A1").End(xlDown).Row
If ws(1).Cells(q, 1).Value Like "*" & DataList & "*" Then
ws(1).Cells(q, 1).Font.Color = RGB(255, 0, 0)
End If
Next q
Next i
For Each MyRNG In ws(1).Range(ws(1).Cells(1, 1), ws(1).Cells(LastRow, 1))
If Not MyRNG.Font.Color = RGB(255, 0, 0) Then
cnt = cnt + 1
ws(3).Cells(cnt, 1).Value = MyRNG.Value
End If
MyRNG.Font.Color = RGB(0, 0, 0)
Next MyRNG
End Sub
※閲覧されてしまった方で、マクロが理解できる方は それはちょっと反則とか...言わないでくださいませ。(笑)
（あみな） 2022/09/07(水) 13:31
リストＡ：森田GG リストＢ：森
この場合、森田GGさんは対象外なんですか？ そんなことはないと思うんですけど･･･
以上、確認だけ （笑） 2022/09/07(水) 15:03
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.