Vba 查找excel中两个文本字段之间的差异

Vba 查找excel中两个文本字段之间的差异,vba,excel,Vba,Excel,我有两个不同的句子。见下面的句子 *,user,rollbacker,accountcreator *,user,accountcreator,rollbacker,sysop 第一句位于单元格A1,第二句位于单元格A2。 如您所见,第二个句子有sysop,这将是区别。 我想在单元格B2中显示单词sysop 我曾尝试过TRIM和SUBSTITUTE,但没有成功,因为第一句中的rollbacker,accountcreator和第二句中的accountcreator,rollbacker的句子排

我有两个不同的句子。见下面的句子

*,user,rollbacker,accountcreator
*,user,accountcreator,rollbacker,sysop
第一句位于单元格A1,第二句位于单元格A2。 如您所见,第二个句子有
sysop
,这将是区别。 我想在单元格B2中显示单词
sysop

我曾尝试过
TRIM
SUBSTITUTE
,但没有成功,因为第一句中的
rollbacker,accountcreator
和第二句中的
accountcreator,rollbacker
的句子排列方式不同

有什么建议吗


谢谢

首先用逗号将两个字符串拆分为两个数组,然后在每个数组中循环使用空格替换任何相同的单词。然后将两个字符串添加到一起,并将它们放置在所需的单元格中

像这样:

Dim fArr() As String
Dim SArr() As String
Dim fStr As String
Dim sStr As String
Dim aStr As String
Dim i As Integer, j As Integer

fStr = Range("A1").value
sStr = Range("A2").value

fArr = Split(fStr, ",")
SArr = Split(sStr, ",")

For i = LBound(fArr) To UBound(fArr)
    sStr = Replace(sStr, fArr(i) & ",", "")
    sStr = Replace(sStr, fArr(i), "")
Next i
For j = LBound(SArr) To UBound(SArr)
    fStr = Replace(fStr, SArr(j) & ",", "")
    fStr = Replace(fStr, SArr(j), "")
Next j

If Trim(fStr) <> "" And Trim(sStr) <> "" Then
    Range("B2") = fStr & "," & sStr
ElseIf Trim(fStr) = "" Then
    Range("B2") = sStr
Else
    Range("B2") = fStr
End If
Dim fArr()作为字符串
Dim SArr()作为字符串
作为字符串的Dim fStr
作为字符串的Dim sStr
调暗aStr为字符串
尺寸i为整数,j为整数
fStr=范围(“A1”).值
sStr=范围(“A2”).值
fArr=拆分(fStr,“,”)
SArr=拆分(sStr,“,”)
对于i=LBound(fArr)到UBound(fArr)
sStr=替换(sStr,fArr(i)和“,”和“)
sStr=替换(sStr,fArr(i),“”)
接下来我
对于j=LBound(SArr)至UBound(SArr)
fStr=替换(fStr,SArr(j)和“,”和“)
fStr=替换(fStr,SArr(j),“”)
下一个j
如果微调(fStr)”和微调(sStr)”,则
范围(“B2”)=fStr&“,”和sStr
其他微调(fStr)=“然后
范围(“B2”)=sStr
其他的
范围(“B2”)=fStr
如果结束

首先用逗号将两个字符串拆分为两个数组,然后在每个数组中循环使用空格替换任何相同的单词。然后将两个字符串添加到一起,并将它们放置在所需的单元格中

像这样:

Dim fArr() As String
Dim SArr() As String
Dim fStr As String
Dim sStr As String
Dim aStr As String
Dim i As Integer, j As Integer

fStr = Range("A1").value
sStr = Range("A2").value

fArr = Split(fStr, ",")
SArr = Split(sStr, ",")

For i = LBound(fArr) To UBound(fArr)
    sStr = Replace(sStr, fArr(i) & ",", "")
    sStr = Replace(sStr, fArr(i), "")
Next i
For j = LBound(SArr) To UBound(SArr)
    fStr = Replace(fStr, SArr(j) & ",", "")
    fStr = Replace(fStr, SArr(j), "")
Next j

If Trim(fStr) <> "" And Trim(sStr) <> "" Then
    Range("B2") = fStr & "," & sStr
ElseIf Trim(fStr) = "" Then
    Range("B2") = sStr
Else
    Range("B2") = fStr
End If
Dim fArr()作为字符串
Dim SArr()作为字符串
作为字符串的Dim fStr
作为字符串的Dim sStr
调暗aStr为字符串
尺寸i为整数,j为整数
fStr=范围(“A1”).值
sStr=范围(“A2”).值
fArr=拆分(fStr,“,”)
SArr=拆分(sStr,“,”)
对于i=LBound(fArr)到UBound(fArr)
sStr=替换(sStr,fArr(i)和“,”和“)
sStr=替换(sStr,fArr(i),“”)
接下来我
对于j=LBound(SArr)至UBound(SArr)
fStr=替换(fStr,SArr(j)和“,”和“)
fStr=替换(fStr,SArr(j),“”)
下一个j
如果微调(fStr)”和微调(sStr)”,则
范围(“B2”)=fStr&“,”和sStr
其他微调(fStr)=“然后
范围(“B2”)=sStr
其他的
范围(“B2”)=fStr
如果结束

我喜欢斯科特的答案,但同时我写了一个更具文字意识的方法:

Public Function CompareCSVStrings(strA As String, strB As String) As String  

Dim varA As Variant  
Dim varB As Variant  
Dim strResults As String
Dim strTest As String

Dim blnDifference As Boolean

Dim intIndexA As Integer
Dim intIndexB As Integer

varA = Split(strA, ",", , vbTextCompare)
varB = Split(strB, ",", , vbTextCompare)

'Look for values in strA that are not in strB
For intIndexA = LBound(varA) To UBound(varA)
    vstrTest = varA(intIndexA)
    blnDifference = True 'assume not present in second array
    For intIndexB = LBound(varB) To UBound(varB)
        If StrComp(varB(intIndexB), strTest, vbTextCompare) = 0 Then
            blnDifference = False 'this string is not a difference after all
        End If
    Next intIndexB
    If blnDifference Then strResults = strResults & "," & strTest
Next intIndexA

'Look for values in strB that are not in strA
For intIndexB = LBound(varB) To UBound(varB)
    strTest = varB(intIndexB)
    blnDifference = True 'assume not present in second array
    For intIndexA = LBound(varA) To UBound(varA)
        If StrComp(varA(intIndexA), strTest, vbTextCompare) = 0 Then
            blnDifference = False 'this string is not a difference after all
        End If
    Next intIndexA
    If blnDifference Then strResults = strResults & "," & strTest
Next intIndexB

CompareCSVStrings = strResults

End Function

我喜欢斯科特的回答,但同时我写了一个更直截了当的方法:

Public Function CompareCSVStrings(strA As String, strB As String) As String  

Dim varA As Variant  
Dim varB As Variant  
Dim strResults As String
Dim strTest As String

Dim blnDifference As Boolean

Dim intIndexA As Integer
Dim intIndexB As Integer

varA = Split(strA, ",", , vbTextCompare)
varB = Split(strB, ",", , vbTextCompare)

'Look for values in strA that are not in strB
For intIndexA = LBound(varA) To UBound(varA)
    vstrTest = varA(intIndexA)
    blnDifference = True 'assume not present in second array
    For intIndexB = LBound(varB) To UBound(varB)
        If StrComp(varB(intIndexB), strTest, vbTextCompare) = 0 Then
            blnDifference = False 'this string is not a difference after all
        End If
    Next intIndexB
    If blnDifference Then strResults = strResults & "," & strTest
Next intIndexA

'Look for values in strB that are not in strA
For intIndexB = LBound(varB) To UBound(varB)
    strTest = varB(intIndexB)
    blnDifference = True 'assume not present in second array
    For intIndexA = LBound(varA) To UBound(varA)
        If StrComp(varA(intIndexA), strTest, vbTextCompare) = 0 Then
            blnDifference = False 'this string is not a difference after all
        End If
    Next intIndexA
    If blnDifference Then strResults = strResults & "," & strTest
Next intIndexB

CompareCSVStrings = strResults

End Function

下面是一个非常直接的方法:

Public Sub ShowDiff()
    [b1] = Diff([a1], [a2])
    [b2] = Diff([a2], [a1])
End Sub
Private Function Diff(a$, b$) As String
    Dim m&, n&
    m = 1
    a = "," & a & ","
    b = "," & b & ","
    Do
        n = InStr(m + 1, a, ",")
        If n Then If InStr(b, Mid$(a, m, n - m + 1)) = 0 Then Diff = Diff & "," & Mid$(a, m + 1, n - m - 1)
        m = n
    Loop Until n = 0
    Diff = Mid$(Diff, 2)
End Function

下面是一个非常直接的方法:

Public Sub ShowDiff()
    [b1] = Diff([a1], [a2])
    [b2] = Diff([a2], [a1])
End Sub
Private Function Diff(a$, b$) As String
    Dim m&, n&
    m = 1
    a = "," & a & ","
    b = "," & b & ","
    Do
        n = InStr(m + 1, a, ",")
        If n Then If InStr(b, Mid$(a, m, n - m + 1)) = 0 Then Diff = Diff & "," & Mid$(a, m + 1, n - m - 1)
        m = n
    Loop Until n = 0
    Diff = Mid$(Diff, 2)
End Function

另一个选择是使用字典

'Reference Microsoft Scripting Runtime

Dim intCounter1 As Integer
Dim strArr1() As String
Dim strArr2() As String
Dim strDif As String
Dim dict1 As Dictionary
Dim varKey As Variant

strArr1 = Split(Cells(1, 1).Value, ",", , vbTextCompare)
strArr2 = Split(Cells(2, 1).Value, ",", , vbTextCompare)
Set dict1 = New Dictionary

For intCounter1 = LBound(strArr1) To UBound(strArr1)
    If dict1.Exists(strArr1(intCounter1)) = False Then
        dict1.Add Key:=strArr1(intCounter1), Item:=1
    End If
Next intCounter1

For intCounter1 = LBound(strArr2) To UBound(strArr2)
    If dict1.Exists(strArr2(intCounter1)) = False Then
        If Len(strDif) = 0 Then
            strDif = strArr2(intCounter1)
        Else
            strDif = strDif & ", " & strArr2(intCounter1)
        End If
    End If
Next intCounter1

Cells(2, 2).Value = strDif

另一个选择是使用字典

'Reference Microsoft Scripting Runtime

Dim intCounter1 As Integer
Dim strArr1() As String
Dim strArr2() As String
Dim strDif As String
Dim dict1 As Dictionary
Dim varKey As Variant

strArr1 = Split(Cells(1, 1).Value, ",", , vbTextCompare)
strArr2 = Split(Cells(2, 1).Value, ",", , vbTextCompare)
Set dict1 = New Dictionary

For intCounter1 = LBound(strArr1) To UBound(strArr1)
    If dict1.Exists(strArr1(intCounter1)) = False Then
        dict1.Add Key:=strArr1(intCounter1), Item:=1
    End If
Next intCounter1

For intCounter1 = LBound(strArr2) To UBound(strArr2)
    If dict1.Exists(strArr2(intCounter1)) = False Then
        If Len(strDif) = 0 Then
            strDif = strArr2(intCounter1)
        Else
            strDif = strDif & ", " & strArr2(intCounter1)
        End If
    End If
Next intCounter1

Cells(2, 2).Value = strDif

第二个总是有额外单词的,还是两个都有在另一个中找不到的单词?单词之间是否总是用逗号分隔?第二个句子后的下一个单元格中的单词可能较少。单词之间总是用逗号分隔。第二个单词总是有额外的单词,还是两个单词都在另一个单词中找不到?单词之间是否总是用逗号分隔?第二个句子后的下一个单元格中的单词可能较少。单词之间总是用逗号分隔。这是一个非常聪明的方法!嗯。你是不是希望所有的输出都显示在B2单元格中,不管是什么?我采取的方法是B1应该显示A1中不在A2中的任何内容。。。同样地,B2应该显示A2中不在A1中的任何内容。你选择了这个答案,所以也许这就是你想要的,但是你的问题中没有明确的答案,而且似乎没有那么有用。这是一个非常聪明的方法!嗯。你是不是希望所有的输出都显示在B2单元格中,不管是什么?我采取的方法是B1应该显示A1中不在A2中的任何内容。。。同样地,B2应该显示A2中不在A1中的任何内容。你选择了这个答案,所以也许这就是你想要的,但这在你的问题中并不清楚,而且似乎没那么有用。