从字符串 excel 中检索多个匹配项

时间:2021-03-16 07:27:50

标签: excel

对不起,如果这是一个愚蠢的问题,但我已经绞尽脑汁好几天了,我似乎无法想出解决方案。

我有一个短语列表和一个需要搜索、提取和替换的关键字列表。

例如,我在表 1 A 列中有以下关键字列表,需要提取并替换为 B 列中的关键字。

red      -     orange

blue     -     violet

green    -     pink

yellow   -     brown

在工作表 2 中,我在 A 列中有一个短语列表。

The girl with blue eyes had a red scarf.

I saw a yellow flower.

My cousin has a red car with blue rims and green mirrors.

并且我想在 B 列中提取与每个短语匹配的关键字,它们的显示顺序完全相同:

COLUMN A                                                        COLUMN B

The girl with blue eyes had a red scarf.                        violet, orange

I saw a yellow flower.                                          brown

My cousin has a red car with blue rims and green mirrors.       orange, violet, pink

有什么办法可以通过公式或VBA来实现吗?这也需要在 Excel 2016 中使用,所以我不能使用像“TEXTJOIN”这样的花哨的函数。

先谢谢大家!

干杯!

L.E.

我找到了一些几乎可以完成我需要它做的事情的代码,但它没有保持正确的顺序。

无论如何可以修改它以生成所需的结果?不幸的是,我对 VBA 不太好。 :(

Sub test()
Dim datacount As Long
Dim termcount As Long

datacount = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
termcount = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To datacount

    dataa = Sheets("Sheet1").Cells(i, "A").Text
    
    result = ""
            
    For j = 1 To termcount
    
        terma = Sheets("Sheet2").Cells(j, "A").Text
        termb = Sheets("Sheet2").Cells(j, "B").Text
        
        If InStr(dataa, terma) > 0 Then
        
             
        If result = "" Then
           
           result = result & termb
           
        Else
        
            result = result & ", " & termb
            
        End If
            
        End If
        
    Next j
    
       Sheets("Sheet1").Cells(i, "B").Value = result
    
    Next i
End Sub

2 个答案:

答案 0 :(得分:0)

我建议您使用 Power Query,它是 Excel 2013 以来的内置函数。

假设 Sheet1 上的颜色文本字符串位于名为 Tbl_LookUp 的表中 Tbl_LookUp

假设 Sheet2 上的短语在另一个名为 Tbl_Phrases 的表中 Tbl_Phrases

转到 Excel 的 Data 选项卡并将两个表加载到 Power Query 编辑器(您可以在 google 上搜索如何将表中的数据加载到 Excel 2016 中的 PQ 编辑器)。请注意,屏幕截图来自 Excel 365。 Data Load Table

加载后,转到Tbl_Phrases 查询,并执行以下步骤:

  1. 添加一个从 1 开始的索引列 Add Index Column
  2. Phrases列按分隔符拆分,使用space作为分隔符,并选择将结果放入rows Split Column
  3. 将当前查询与 Tbl_LookUp 查询合并,使用 Phrase 列匹配 Old TextMerge with Look Up Table
  4. 展开新列以显示 New Text 列中的内容 Expand the table Show New Text
  5. New Text列按Index列分组,您可以选择对New Text列中的值求和,分组后会出现错误。转到公式字段并将公式的这一部分 List.Sum([New Text]) 替换为 Text.Combine([New Text],", ")。按回车键,错误将被更正为所需的文本字符串。 Group Texts

以下是上述查询的完整M 代码。您可以将其复制并粘贴到高级编辑器中,而无需手动执行每个步骤:

let
    Source = Excel.CurrentWorkbook(){[Name="Tbl_Phrases"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Phrases", type text}}),
    #"Added Index" = Table.AddIndexColumn(#"Changed Type", "Index", 1, 1, Int64.Type),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Added Index", {{"Phrases", Splitter.SplitTextByDelimiter(" ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Phrases"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Phrases", type text}}),
    #"Merged Queries" = Table.NestedJoin(#"Changed Type1", {"Phrases"}, Tbl_LookUp, {"Old Text"}, "Tbl_Replace", JoinKind.LeftOuter),
    #"Expanded Tbl_Replace" = Table.ExpandTableColumn(#"Merged Queries", "Tbl_Replace", {"New Text"}, {"New Text"}),
    #"Grouped Rows" = Table.Group(#"Expanded Tbl_Replace", {"Index"}, {{"Look up color", each Text.Combine([New Text],", "), type nullable text}})
in
    #"Grouped Rows"

当您在 Tbl_Phrases 查询中添加索引列后,即上面的第 1 步,您可以制作该查询的副本(只需右键单击原始查询并选择“复制” ),那么您将有第二个查询,称为Tbl_Phrases (2)。在您完成编辑原始查询并得到所需文本字符串之前,无需处理此查询。

然后您可以使用索引列将 Tbl_Phrases (2) 查询与 Tbl_Phrases 查询合并。展开新列以显示 look up colour 列中的内容。最后,将 Phrases 列与带有分隔符 look up color(space)-(space) 列合并,并删除索引列,然后您应该拥有所需的文本字符串。

Merge Columns

这是 Tbl_Phrases (2) 查询的 M 代码。提醒一下,您必须先完成Tbl_Phrases 查询,否则合并查询步骤将导致错误:

let
    Source = Excel.CurrentWorkbook(){[Name="Tbl_Phrases"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Phrases", type text}}),
    #"Added Index" = Table.AddIndexColumn(#"Changed Type", "Index", 1, 1, Int64.Type),
    #"Merged Queries" = Table.NestedJoin(#"Added Index", {"Index"}, Tbl_Phrases, {"Index"}, "Tbl_Phrases", JoinKind.LeftOuter),
    #"Expanded Tbl_Phrases" = Table.ExpandTableColumn(#"Merged Queries", "Tbl_Phrases", {"Look up color"}, {"Look up color"}),
    #"Merged Columns" = Table.CombineColumns(#"Expanded Tbl_Phrases",{"Phrases", "Look up color"},Combiner.CombineTextByDelimiter(" - ", QuoteStyle.None),"Merged"),
    #"Removed Columns" = Table.RemoveColumns(#"Merged Columns",{"Index"})
in
    #"Removed Columns"

然后您可以将 Tbl_Phrase (2) 查询加载到同一工作簿中的所需工作表(或 Sheet2 上的某处)。 Outcome

如果您有任何问题,请告诉我。

答案 1 :(得分:0)

您可以通过使用正则表达式的用户定义函数来做到这一点。

工作表公式:

=matchWords(A2,$K$2:$L$5)

其中 A2 包含句子,第二个参数指向翻译表(可能在另一个工作表上)。

代码

Option Explicit
Function matchWords(ByVal s As String, translTbl As Range) As String
    Dim RE As Object, MC As Object, M As Object
    Dim AL As Object 'collect the replaced words
    Dim TT As Variant
    Dim I As Long
    Dim vS As Variant
'create array
TT = translTbl

'initiate array for output
Set AL = CreateObject("system.collections.arraylist")

'initiate regular expression engine
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True 'could change this if you want
    .Pattern = "\w+" 'can change this if need to include some non letter/digit items
    
    'split the sentence, excluding punctuation
    If .test(s) Then
        Set MC = .Execute(s)
            For Each M In MC
                For I = 1 To UBound(TT, 1)
                    If M = TT(I, 1) Then AL.Add TT(I, 2)
                Next I
            Next M
    End If
End With
    
matchWords = Join(AL.toarray, ", ")
    
End Function

enter image description here

相关问题