Question

我在工作表列中有一个层次结构编码系统。我想在该列中查找与该列上的值部分匹配的值。搜索应从较长的值开始。这里是样本：

AME_ASO_010_010_010

AME_ASO_010_010_010_010（值越长，搜索开始）

总之，我寻找一些寻找匹配的想法，而不考虑最后四个地方（_010）。谢谢大家！任何支持将不胜感激！

随着dwirony的贡献，我试着这个。有人请知道为什么给我对象所需的错误（424）。非常感谢！它失败了＆gt; Left（cell，Len（cell） - 4）。Offset（，1）.Select

Sub main()
Dim cell As Range
Dim arr As Variant, arrElem1 As Variant
Dim rng As Range
Dim sh1 As Worksheet

Set sh1 = Sheets("Valeurs")

  With Worksheets("Valeurs")
    For Each cell In .Range("E1", .Cells(.Rows.Count, "E").End(xlUp))
    Set rng = Range(cell, cell.Offset(0, 12))

            arr = Split(Replace(cell.Value, "  ", " "), " ")
            For Each arrElem1 In arr
            If Len(arrElem1) = 15 Then

                Left(cell, Len(cell) - 4).Offset(, 1).Select
                With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent4
                .TintAndShade = -0.249977111117893
                .PatternTintAndShade = 0
                End With

            End If
            Next arrElem1
    Next cell
End With

End Sub

Answer 1

尝试并尝试成功已经到来！这里的代码可能对其他人有用。主题已关闭！

Sub main()
Dim i As Long
Dim cell As Range
Dim lResult As String
Dim arr As Variant, arrElem1 As Variant
Dim rng As Range, rng1 As Range
Dim sh1 As Worksheet

    With Worksheets("Valeurs")
    For Each cell In .Range("E1", .Cells(.Rows.Count, "E").End(xlUp))

        arr = Split(Replace(cell.Value, "  ", " "), " ")
            For Each arrElem1 In arr
            If Len(arrElem1) = 15 Then
            lResult = Left(arrElem1, Len(arrElem1) - 4)
                Set rng1 = sh1.Range("E15:E10000")
                Set Findv = Range("E15:E10000").Cells.Find(What:=lResult, LookAt:=xlWhole, _
                After:=Range("E15"), SearchDirection:=xlPrevious)
                Findv.Offset(0, 1).Select
                    With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent4
                    .TintAndShade = -0.249977111117893
                    .PatternTintAndShade = 0
                    End With

            End If
            Next arrElem1
    Next cell
    End With

End Sub

部分匹配子串

1 个答案: