比较两个单元格中的字符串，相同的字符用红色标出，求大神VBA 指点

734yu

大神求助，
想要比较两个单元格中的字符串，相同的字符用红色标出，希望大小写不会影响整个功能。
请看如下情况，希望能够实现这样的功能，能够highlight标出同样的字符，因为本人是VBA 小白，求大神指教，万分感谢！！！

liulang0808

1. Option Compare Text
   
2. Sub 按钮1_Click()
   
3.     Application.ScreenUpdating = False
   
4.     arr = [a1].CurrentRegion
   
5.     For j = 6 To UBound(arr)
   
6.         For i = Len(arr(j, 2)) To 2 Step -1
   
7.             str1 = Left(arr(j, 2), i)
   
8.             x = InStr(arr(j, 1), str1)
   
9.             If x > 0 Then
   
10.                 Cells(j, 2).Characters(1, Len(str1)).Font.ColorIndex = 3
    
11.                 Cells(j, 1).Characters(x, Len(str1)).Font.ColorIndex = 3
    
12.                 For k = i + 1 To 2 Step -1
    
13.                     str1 = Right(arr(j, 2), k)
    
14.                     y = InStr(arr(j, 1), str1)
    
15.                     If y > x Then
    
16.                         Cells(j, 2).Characters(Len(arr(j, 2)) - Len(str1) + 1, Len(str1)).Font.ColorIndex = 3
    
17.                         Cells(j, 1).Characters(y, Len(str1)).Font.ColorIndex = 3
    
18.                         Exit For
    
19.                     End If
    
20.                 Next
    
21.                 Exit For
    
22.             End If
    
23.         Next i
    
24.     Next j
    
25.     Application.ScreenUpdating = True
    
26. End Sub

复制代码

liulang0808

欢迎新朋友，建议以后发帖上传附件
根据楼主目前的模拟数据，按照第二列左侧数据有匹配采取匹配右侧数据来处理的，供参考

Goodeve705

1. Sub compare()
   
2.     Dim arr, brr
   
3. 
   
4.     For i1 = 2 To Cells(10000, 1).End(xlUp).Row
   
5.         str1 = Cells(i1, 1)
   
6.         str2 = Cells(i1, 2)
   
7.         n = Len(str1)
   
8.         
   
9.         ReDim arr(1 To n)
   
10.         ReDim brr(1 To n)
    
11.         
    
12.         For ii1 = 1 To n
    
13.             arr(ii1) = Left(str1, ii1)
    
14.             brr(ii1) = Right(arr(ii1), 1)
    
15.             
    
16.             nn1 = InStr(str2, brr(ii1))
    
17.             nn2 = InStr(str2, Chr(Asc(brr(ii1)) + 32))
    
18.             nn3 = InStr(str2, Chr(Asc(brr(ii1)) - 32))
    
19.             If nn1 Or nn2 Or nn3 Then
    
20.                 Cells(i1, 1).Characters(ii1, 1).Font.ColorIndex = 3
    
21.             End If
    
22.         Next
    
23.         
    
24.     Next
    
25. 
    
26. End Sub

复制代码

拆分第一列字符串，instr与第二列比较，存在则变色
拆分第二列字符串，instr与第二列比较，存在则变色（我没写）原理同上

734yu

liulang0808 发表于 2019-11-12 20:46
欢迎新朋友，建议以后发帖上传附件
根据楼主目前的模拟数据，按照第二列左侧数据有匹配采取匹配右侧数据来 ...

大神，这个情况还有一种就是中间有空格的或者顺序颠倒的也希望能够匹配的上，类似这种，可以么，非常感谢

734yu

Goodeve705 发表于 2019-11-12 23:51
拆分第一列字符串，instr与第二列比较，存在则变色
拆分第二列字符串，instr与第二列比较，存在则变色（ ...

感谢回复，这个我试了一下是重复匹配的对吗，就是只要有相同字符就会标红。我表述的还是不够清楚，我希望能够得到的情况是两个相邻顺序一样的，这样的才考虑标红，还有就是说不会被空格影响，要是能同时加粗就更好了。感谢感谢！

Goodeve705

首先处理字符串，（去掉空格，变小写）
然后拆分字符串（每两字符）
最后instr判断，存在则变红变粗（暂时没有代码嘻嘻）

734yu

Goodeve705 发表于 2019-11-13 11:14
首先处理字符串，（去掉空格，变小写）
然后拆分字符串（每两字符）
最后instr判断，存在则变红变粗（暂 ...

感谢回复，但是我自己写确实还是有点难，希望大神有空的时候能够再给一下代码，感谢！！!

liulang0808

734yu 发表于 2019-11-13 09:56
大神，这个情况还有一种就是中间有空格的或者顺序颠倒的也希望能够匹配的上，类似这种，可以么，非常感谢 ...

楼主这种比较存在其他可能，多少个字符组合算是有效的
abcdxyzbcdef    abcdef
这样的怎么办？算是怎么匹配的？

还会有其他组合，最后的结果，可以理解为缩小到取每个字符去匹配了。比如4楼代码

之前的代码是按照取左侧字符串，匹配之后，才匹配右侧剩余字符串，不是取其中一段匹配。

734yu

liulang0808 发表于 2019-11-13 12:18
楼主这种比较存在其他可能，多少个字符组合算是有效的
abcdxyzbcdef    abcdef
这样的怎么办？算是怎么 ...

感谢回复，我也是觉得按照左侧字符串匹配之后才匹配剩余的比较好，但是我试了这串代码发现有一部分不显示匹配，请您看一下为什么前几行不显示呢，再次感谢大神指教！