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

如果您现在选择行范围并运行宏-它将为基于X和Y列输入选择的每一行填充Z列。

Sub Macro1()
  ' https://stackoverflow.com/questions/54732564/compare-two-strings-and-return-matched-values
  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部分并每次添加。

Answer 2

这是另一个使用Dictionary对象评估匹配项的版本。

它还使用数组来加快处理速度-对大型数据集很有用。

请务必按照代码注释中的说明设置参考，但如果要分发此代码，则可能更喜欢使用后期绑定。

一个假设是您所有的值都是数字。如果某些内容包含文本，则您可能（或可能不希望）将字典的comparemode更改为Text。

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

比较两个字符串并返回匹配的值？

2 个答案: