Сравнить две строки и вернуть совпадающие значения?

Question

Я хочу сравнить две строки в двух соседних ячейках.Все значения разделены запятой.Возвращает совпадающие значения, разделенные запятой.

Значения иногда повторяются более одного раза и могут находиться в разных частях строки.Самая большая длина строки в моем списке - 6264.

например

Cell X2 = 219728401, 219728401, 219729021, 219734381, 219735301, 219739921

Cell Y2 = 229184121, 219728401, 219729021, 219734333, 216235302, 219735301

Result/Output = 219728401, 219729021, 219735301

Ячейки, к которым я хотел бы применить это, не ограничены только X2 и Y2, это будут столбцы X иY, с выводом в столбец Z (или в столбец, который я могу указать).

Я ценю любую помощь в этом, поскольку мои знания VBA ограничены в Excel.

Спасибо.

Answer 1

Вот еще одна версия, которая использует объект Dictionary для оценки совпадений.

Она также использует массивы для ускорения обработки - полезно с большими наборами данных.

Обязательно установите ссылкукак отмечено в комментариях к коду, но если вы собираетесь распространять этот код, вы можете предпочесть использовать позднюю привязку.

Одно из предположений состоит в том, что все ваши значения являются числовыми.Если некоторые из них содержат текст, вы можете (или не можете) изменить режим сравнения словаря на Текст.

Option Explicit
'Set reference to Microsoft Scripting Runtime

Sub MatchUp()
    Dim WS As Worksheet, R As Range
    Dim V, W, X, Y, Z
    Dim D As Dictionary
    Dim I As Long

Set WS = Worksheets("sheet1") 'Change to your desired worksheet
With WS
    'Change `A` to `X` for your stated setup
    Set R = .Range(.Cells(1, "A"), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)

    'Read range into variant array
    V = R
End With

For I = 2 To UBound(V, 1)
    W = Split(V(I, 1), ",")
    X = Split(V(I, 2), ",")
    V(I, 3) = ""

    'Test and populate third column (in array) if there are matches
    'Will also eliminate any duplicate codes within the data columns
    Set D = New Dictionary
        For Each Y In W
            Y = Trim(Y) 'could be omitted if no leading/trailing spaces
            If Not D.Exists(Y) Then D.Add Y, Y
        Next Y
        For Each Z In X
            Z = Trim(Z)
            If D.Exists(Z) Then V(I, 3) = V(I, 3) & ", " & Z
        Next Z
    V(I, 3) = Mid(V(I, 3), 3)
Next I

R.EntireColumn.Clear
R.EntireColumn.NumberFormat = "@"
R.Value = V 'write the results back to the worksheet, including column 3
R.EntireColumn.AutoFit
End Sub

Answer 2

Если вы сейчас выберите диапазон строк и запустите макрос - он заполнит столбец Z для каждой строки, выбранной на основе входов столбцов X и Y.

Sub Macro1()
  ' /12076191/sravnit-dve-stroki-i-vernut-sovpadayschie-znacheniya
  Dim XString       As String
  Dim YString       As String
  Dim XArray()      As String
  Dim YArray()      As String
  Dim xe            As Variant
  Dim ye            As Variant
  Dim res           As Variant
  Dim ZString       As String
  Dim resCollection As New Collection
  Dim XColumnNumber As Long
  Dim YColumnNumber As Long
  Dim ZColumnNumber As Long
  Dim found         As Boolean
  XColumnNumber = Range("X1").Column
  YColumnNumber = Range("Y1").Column ' Could have done XColumn + 1 ! But if you want F and H it will work too now.
  ZColumnNumber = Range("Z1").Column ' Your result goes here
  Set resCollection = Nothing
  For Each r In Selection.Rows
    XString = ActiveSheet.Cells(r.Row, XColumnNumber).Value
    YString = ActiveSheet.Cells(r.Row, YColumnNumber).Value
    Debug.Print "XString: "; XString
    Debug.Print "YString: "; YString
    XArray = Split(XString, ",")
    YArray = Split(YString, ",")
    For Each xe In XArray
      Debug.Print "xe:"; xe
      For Each ye In YArray
        Debug.Print "ye:"; ye
        If Trim(xe) = Trim(ye) Then
          Debug.Print "Same trimmed"
          found = False
          For Each res In resCollection
            If res = Trim(xe) Then
                found = True
                Exit For
            End If
          Next res
          Debug.Print "Found: "; found
          If Not (found) Then
            resCollection.Add Trim(xe)
            Debug.Print "Adding: "; xe
          End If
        End If
      Next ye
    Next xe
    Debug.Print "resCollection: "; resCollection.Count
    ZString = ""
    For Each res In resCollection
        ZString = ZString & Trim(res) & ", "
    Next res
    If Len(ZString) > 2 Then
      ZString = Left(ZString, Len(ZString) - 2)
    End If
    ActiveSheet.Cells(r.Row, ZColumnNumber).Value = ZString
  Next r
End Sub

Обратите внимание, если у вас 2,1, 2 и 2,5,2 и хотите 2,2, затем удалите часть If Not Found и добавляйте каждый раз.