高级Excel排序

我有一个简短的问题

我有一张Excel表格。。其中包含某些项目的描述：例如：

1) Awesome mirror
2) Another Awesome mirror
3) beautiful table
4) Pretty beautiful lovely sofa
5) one more mirror

and so on...

比如说，我想把所有的镜子放在一起，所有的桌子放在一起。。。 等等基本上，它可以返回所有包含“镜像”这个词的实例

---

关于如何解决这个问题，您有什么想法吗？

您可以创建一个新列并使用此自定义项：

Function WhatIsIt(LineItem As Range, AllThings As Range) As String
    Dim rv As String, c As Range
    Dim v As String, thing As String

    v = UCase(LineItem.Cells(1).Value)
    rv = ""

    If Len(v) > 0 Then
        For Each c In AllThings.Cells
            thing = c.Value
            If Len(thing) > 0 And InStr(v, UCase(thing)) > 0 Then
                rv = thing
                Exit For
            End If
        Next c
    End If
    WhatIsIt = rv
End Function

“AllThings”是一个范围，其中列出了您想要查找的内容。一定要把较长的词放在第一位：即“沙发桌”应该放在“沙发”或“桌子”之前

---

注意，它可能需要一些改进：当一个术语只是项目描述中另一个单词的一部分时，它也将返回匹配项。

您可以使用如下公式解决方案：

=SUM(COUNTIF(A1,"*"&{"table","mirror","sofa"}&"*")*{1,100,1000})

将给予

表

1分

mirror

100分

sofa

1000分

允许简单的数字排序

如果一个单元格可能同时包含

mirror

和

sofa

，那么它将得到101分。在这种情况下，您可以：

• 很高兴有一个单独的多重匹配列表
• 我可以进一步调整公式，如果你能提供你希望如何处理多重匹配

---

另一种可能性是ADO。当一个项目出现两次时，将返回两行。还可以在ToFind中使用另一个列，该列允许

不类似于
：
类似于“%”和[ToFind]&“%”，而不类似于“%”和[NotToFind]&“%”

输入

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''[ToFind] is a named range, but it does not have to be.
strSQL = "SELECT DISTINCT [List], [ToFind] " _
       & "FROM [Sheet1$A:A] a, " _
       & "[ToFind] b " _
       & "WHERE List Like '%' & [ToFind] & '%'"

rs.Open strSQL, cn, 3, 3


''Pick a suitable empty worksheet for the results

Worksheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing


结果

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''[ToFind] is a named range, but it does not have to be.
strSQL = "SELECT DISTINCT [List], [ToFind] " _
       & "FROM [Sheet1$A:A] a, " _
       & "[ToFind] b " _
       & "WHERE List Like '%' & [ToFind] & '%'"

rs.Open strSQL, cn, 3, 3


''Pick a suitable empty worksheet for the results

Worksheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing


如果您只想显示列表中的所有“表”，为什么不在搜索字段中使用自动筛选结束类型表呢。这样，只有字符串中带有单词“Table”的项才会显示。所有其他行都将被隐藏

问候,

Robert
行项目可以包含多个“东西”吗？如；“绝佳的桌子和镜子组合”或“绝佳的沙发桌”