Похожие строки в двух ячейках в excel

Похожие строки в двух ячейках в excel
Похожие строки в двух ячейках в excel

можете попробовать этот код:

Option Base 1
    Sub CompareStrings2()
        Application.ScreenUpdating = False
        If Selection.Columns.Count <> 2 Then GoTo MyExitSub
        Dim i As Long, lenC1 As Long, lenC2 As Long, r As Long, y As Long, x As Long, ChkLen As Long, OffSetCol As Long
        Dim C1Str As String, C2Str As String, tempStr As String
        Dim ArrC1(), ArrC2, ArrSel, ArrResult
        ArrSel = Selection
        i = UBound(ArrSel, 1)
        ReDim ArrResult(i)
        ReDim ArrC1(i)
        ReDim ArrC2(i)
        For r = LBound(ArrC1, 1) To UBound(ArrC1, 1)
            ArrC1(r) = ArrSel(r, 1)
            ArrC2(r) = ArrSel(r, 2)
        Next r
        ChkLen = 3 ' change this number to be the minimum recognised length, i.e. 1 for a single letter.
            If Len(C1Str) > Len(C2Str) Then
            tempStr = C2Str
            C2Str = C1Str
            C1Str = tempStr
            End If
        For r = LBound(ArrC1, 1) To UBound(ArrC1, 1)
            C1Str = ArrC1(r)
            lenC1 = Len(C1Str)
            C2Str = ArrC2(r)
            lenC2 = Len(C2Str)
            For x = Len(C1Str) To ChkLen Step -1
                For y = 1 To Len(C1Str) - ChkLen
                If InStr(C2Str, Trim(Mid(C1Str, y, x))) Then
                    ArrResult(r) = Trim(Mid(C1Str, y, x))
                    GoTo MyNxtr
                End If
                Next y
            Next x
    MyNxtr:
        OffSetCol = 2 ' Change this value to change the offset column.
        Next r
        For i = LBound(ArrResult) To UBound(ArrResult)
        Selection.Cells(1, 1).Offset(i - 1, OffSetCol) = Trim(ArrResult(i))
        Next i
    MyExitSub:
    Application.ScreenUpdating = True
    End Sub

Измените значение ChkLen на минимальное совпадение, которое вы ищете, выделите два столбца для сравнения, и результат должен быть помещен в следующий столбец (например, если вы выберете диапазон A2:B10, результаты появятся в C2:C10. Если вы хотите изменить смещение колонки результата

в модуле и связать с кнопкой или иным образом запустить код из редактора VBA.

Рекомендую посмотреть эти видео для лучшего погружения в вопрос:

Прикрепленное видео 1 - Excel. Сравнение значений ячеек в двух столбцах

Прикрепленное видео 2 - Сравнение двух списков в Excel (Различия & Сходства)


NevaDev, 29 января 2023 г., 08:01