使用分隔符分割的相同值格式化单元格，但VBA中的顺序不同

我是一个VBA初学者，似乎无法找到一个解决方案，一开始似乎是一个非常简单的比较

基本上，我有两列，其中单元格中的值由分隔符分割，但顺序不同

例如

然后，B1应突出显示为副本

我正在搜索一些vba代码，我可以使用这些代码在A列和B列中循环使用的范围，以比较和突出显示B列中重复的单元格，如上面的示例所示

抱歉如果我错过了之前提出和回答的任何类似问题，我确实进行了搜索，但可能我的搜索条件超出了范围，我根本没有遇到VBA解决方案

问候,，

---

Enjay

根据提供的少量信息，您可以尝试以下代码

Sub Highlight()

Const DELIMITER = "|"
Dim rg As Range
Dim a As Variant
Dim b As Variant
Dim sngCell As Range

    Set rg = Range("A1:A3")
    For Each sngCell In rg

        a = Split(sngCell.Value2, DELIMITER)
        b = Split(sngCell.Offset(, 1).Value2, DELIMITER)

        If isEqual(a, b) Then
            With sngCell.Offset(, 1).Interior
                .ThemeColor = xlThemeColorAccent6
            End With
        End If
    Next sngCell

End Sub

具有以下功能

Function isEqual(a As Variant, b As Variant) As Boolean

    a = BubbleSort(a)
    b = BubbleSort(b)

    isEqual = True

    Dim i As Long
    For i = LBound(a) To UBound(a)
        If a(i) <> b(i) Then
            isEqual = False
            Exit For
        End If
    Next i

End Function

Function BubbleSort(ByRef strArray As Variant) As Variant
    'sortieren von String Array
    'eindimensionale Array
    'Bubble-Sortier-Verfahren
   Dim z       As Long
   Dim i       As Long
   Dim strWert As Variant

    For z = UBound(strArray) - 1 To LBound(strArray) Step -1
        For i = LBound(strArray) To z
            If LCase(strArray(i)) > LCase(strArray(i + 1)) Then
                strWert = strArray(i)
                strArray(i) = strArray(i + 1)
                strArray(i + 1) = strWert
            End If
        Next i
    Next z

    BubbleSort = strArray

End Function

函数isEqual（a作为变量，b作为变量）作为布尔值
a=气泡运动（a）
b=气泡运动（b）
等质量=真
我想我会坚持多久
对于i=LBound（a）到UBound（a）
如果a（i）b（i）那么
等质量=假
退出
如果结束
接下来我
端函数
函数BubbleSort（ByRef strArray作为变量）作为变量
'sortieren von字符串数组
“eInDimensional数组”
“泡泡魔术师维法伦
暗z一样长
我想我会坚持多久
作为变体的Dim strWert
对于z=UBound（strArray）-1至LBound（strArray）步骤-1
对于i=LBound（strArray）到z
如果LCase（strArray（i））>LCase（strArray（i+1）），那么
strWert=strArray（一）
strArray（i）=strArray（i+1）
strArray（i+1）=strWert
如果结束
接下来我
下一个z
泡泡糖
端函数

这将按原样回答您的问题。如果解决方案需要调整，我相信您可以解决：）

这使用

StrComp

（仅在内存中）对两个字符串部分重新排序，以便可以轻松检测重复值

Option Explicit

Sub DuplicateCheck()

    Dim delimiter As String
    delimiter = "|"

    Dim lastCol As Long
    lastCol = Cells(1, Columns.count).End(xlToLeft).Column

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To lastCol
        Dim theSplit As Variant
        theSplit = Split(Cells(1, i), delimiter)

        Dim temp As String

        If StrComp(theSplit(0), theSplit(1), vbTextCompare) = 1 Then
            temp = theSplit(1)
            theSplit(1) = theSplit(0)
            theSplit(0) = temp
        End If

        temp = theSplit(0) & delimiter & theSplit(1)

        If Not dict.exists(temp) Then
            dict.Add (temp), 1
        Else
            Cells(1, i).Interior.color = 65535
        End If

    Next i

End Sub

---

你愿意分享你已有的代码吗？如果您已经可以按顺序比较“componentwise/”，那么我建议只添加两个内部循环，将第一个字段的每个子值与第二个字段的每个子值进行“交叉检查”。这些值是否只有一个分隔符？如果只有两个项，则条件格式将执行此操作，这是一个很长的公式，但是没有vba也可以做到。谢谢，这肯定是一个解决方案，我会相应地调整：）我感谢你的时间和努力。很好地使用StrComp使键具有可比性+1）。为了防止在第1行的单元格发生可能的更改后需要再次处理代码，我建议在

For

-

Next

循环之前声明

ws.Range（“1:1”）.Interior.ColorIndex=xlColorIndexNone

，以清除所有当前格式@Enjay的旁注：我总是更喜欢完全限定的范围引用，所以应该声明并设置一个工作表对象（例如

Dim ws As worksheet

和

set ws=thishworkbook.Worksheets（“Marcucci”）

），并将其用作前缀，如

ws.Cells（1，I）.Interior.Color

或`ws.Cells（…）。@T.M.谢谢fam。在某种程度上，当我把它放在一起的时候，我已经设置好了撤销着色，不知道为什么我删除了它！不过，Storax的答案最终解决了所有情况，因为它可以使用带有多个分隔符的字符串。这也是一个完美的解决方案：）谢谢，非常感谢。

Option Explicit

Sub DuplicateCheck()

    Dim delimiter As String
    delimiter = "|"

    Dim lastCol As Long
    lastCol = Cells(1, Columns.count).End(xlToLeft).Column

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To lastCol
        Dim theSplit As Variant
        theSplit = Split(Cells(1, i), delimiter)

        Dim temp As String

        If StrComp(theSplit(0), theSplit(1), vbTextCompare) = 1 Then
            temp = theSplit(1)
            theSplit(1) = theSplit(0)
            theSplit(0) = temp
        End If

        temp = theSplit(0) & delimiter & theSplit(1)

        If Not dict.exists(temp) Then
            dict.Add (temp), 1
        Else
            Cells(1, i).Interior.color = 65535
        End If

    Next i

End Sub