问公式，用于比较一列行中字符串数是否相等。

EN

'These Options declaration always go at the top of the module, class, etc. 
Option Explicit
Option Base 1

Sub Get_Overlap()
Const kFlag As String = "Overlapping"   'Change as required
Dim rData As Range, aData As Variant, aResults() As String, sResult As String
Dim lA As Long, sAvalue As String, iAp As Integer, bA1 As Byte, bA2 As Byte
Dim lB As Long, sBvalue As String, iBp As Integer, bB1 As Byte, bB2 As Byte

    Rem Sets Data Range & Arrays
    With ThisWorkbook.Sheets("TEST").Columns("B")   'Change as required
        Set rData = Range(.Cells(2), .Cells(Rows.Count).End(xlUp))
    End With
    aData = rData.Value2
    aData = WorksheetFunction.Transpose(aData)
    rData.Offset(0, 1).ClearContents
    ReDim Preserve aResults(UBound(aData))

    For lA = 1 To UBound(aData)

        Rem Initialize & Set Item A Values
        sAvalue = Empty: sAvalue = aData(lA)
        iAp = 0: iAp = Left(sAvalue, 1)
        bA1 = 0: bA1 = Mid(sAvalue, 3, 1)
        On Error Resume Next
        bA2 = 0: bA2 = Mid(sAvalue, 4, 1)
        On Error GoTo 0

        For lB = lA + 1 To UBound(aData)

            Rem Initialize & Set Item B Values
            sBvalue = Empty: sBvalue = aData(lB)
            iBp = 0: iBp = Left(sBvalue, 1)
            bB1 = 0: bB1 = Mid(sBvalue, 3, 1)
            On Error Resume Next
            bB2 = 0: bB2 = Mid(sBvalue, 4, 1)
            On Error GoTo 0

            Rem Initialize Comparison Result
            sResult = Empty

            Rem Compare Items & Values
            Select Case True
            Case sAvalue = sBvalue
                sResult = kFlag

            Case iAp = iBp
                Select Case True
                Case bA2 = 0 And bB2 = 0
                    If (bA1 = bB1) Then sResult = kFlag

                Case bA2 = 0
                    If bA1 >= bB1 And bA1 <= bB2 Then sResult = kFlag

                Case bB2 = 0
                    If bB1 >= bA1 And bB1 <= bA2 Then sResult = kFlag

                Case Else
                    If bA1 >= bB1 And bA1 <= bB2 Then
                        sResult = kFlag
                    ElseIf bA2 >= bB1 And bA2 <= bB2 Then
                        sResult = kFlag
                    ElseIf bB1 >= bA1 And bB1 <= bA2 Then
                        sResult = kFlag
                    ElseIf bB2 >= bA1 And bB2 <= bA2 Then
                        sResult = kFlag
                    End If

            End Select: End Select

            Rem Add Results into Array
            If sResult <> Empty Then
                aResults(lA) = sResult
                aResults(lB) = sResult
            End If

    Next: Next

    Rem Enter Comparison Results
    'Results will be posted one column to the right of where the List
    'This is done by the use of "rData.Offset(0,1)"
    rData.Offset(0, 1).Value = WorksheetFunction.Transpose(aResults)

    End Sub