Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
' https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=161168&TITLE_SEO=161168-poisk-konsensusnoy-posledovatelnosti
'==================================================================================================
Private Function JF_MainString_Matrix(rngIn As Range, sOut$) As Boolean
Dim x, aMatrix&(), aJ$(), aBt() As Byte, aComp&()
Dim n&, r&, c&, b&, l&, lMax&, chSym&, chMax&, chCount&, chRate&

n = rngIn.Cells.CountLarge
If (n = 1) Then JF_MainString_Matrix = rngIn.Value2: Exit Function

chMax& = 122    ' TableMaxSym
ReDim aComp(chMax)
ReDim aMatrix(n, 100): n = 0

For Each x In rngIn.Value2
    If (VarType(x) <> vbString) Then GoTo nx
    If (x = "") Then GoTo nx
    
    chSym = AscW(x): If (chSym > chMax) Then chMax = 1105: ReDim Preserve aComp(chMax)
    aComp(chSym) = aComp(chSym) + 1
    If (aComp(chSym) > chCount) Then chCount = aComp(chSym): chRate = chSym

    aBt = x: l = 0.5 * (UBound(aBt) + 1)
    If (lMax < l) Then lMax = l
    If (l = 1) Then GoTo nx
    c = 0: n = n + 1

    For b = 2 To UBound(aBt) - 1 Step 2
        c = c + 1: aMatrix(n, c) = aBt(b) + 256 * aBt(b + 1)
    Next b
nx:
Next x

If (chRate <> 0) Then JF_MainString_Matrix = True Else Exit Function
If (n = 0) Then sOut = ChrW$(chRate): Exit Function

' Variant on JoinArray(same Time) ---------------
ReDim aJ(lMax): aJ(1) = ChrW$(chRate)

For c = 1 To lMax - 1
    ReDim aComp(chMax): chCount = 0: chRate = 0

    For r = 1 To n
        If (aMatrix(r, c) <> 0) Then
            chSym = aMatrix(r, c)
            aComp(chSym) = aComp(chSym) + 1
            If (aComp(chSym) > chCount) Then chCount = aComp(chSym): chRate = chSym
        End If
    Next r

    If (chRate = 0) Then Stop: End
    aJ(c + 1) = ChrW$(chRate)
Next c

sOut = Join(aJ, "")
End Function

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
' https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=160990&TITLE_SEO=160990-naibolee-dlinnaya-podstroka
'==================================================================================================
Private Function pv_Rng_GetUniqStrings(rngIn As Range, lMin_Out&, sMin_Out$, aStrOth_Out() As String) As Boolean
Dim x, arr, a&, l&, n&, nMin&
Static dic As New Dictionary

ReDim aStrOth_Out(rngIn.Cells.CountLarge)
lMin_Out = 40000

For a = 1 To rngIn.Areas.Count
    arr = rngIn.Areas(a).Value2
    If Not IsArray(arr) Then arr = Array(arr)

    For Each x In arr
        If (VarType(x) <> vbString) Then GoTo nx
        If (x = "") Then GoTo nx
        If dic.Exists(x) Then GoTo nx
        
        n = n + 1: aStrOth_Out(n) = x
        dic.add aStrOth_Out(n), 0
        l = Len(aStrOth_Out(n)): If (lMin_Out > l) Then lMin_Out = l: nMin = n
    Next x
nx:
Next a

dic.RemoveAll: If (nMin = 0) Then Exit Function
sMin_Out = aStrOth_Out(nMin)

For a = nMin + 1 To n
    aStrOth_Out(a - 1) = aStrOth_Out(a)
Next a

ReDim Preserve aStrOth_Out(n - 1)
pv_Rng_GetUniqStrings = True
End Function
'--------------------------------------------------------------------------------------------------
Private Function pv_MainSubString(lMin_In&, sMin_In$, aStrOth_In() As String, lMax_Out&, sSubStr_Out$) As Boolean
Dim sSrch$, n&, i&, lSrch&

lMax_Out = 0: i = 1: lSrch = 1

Do
rp: sSrch = Mid$(sMin_In, i, lSrch)

    For n = 1 To UBound(aStrOth_In)
        If (InStr(aStrOth_In(n), sSrch) = 0) Then
            If (lMax_Out >= lMin_In - i) Then GoTo ex
            i = i + 1: lSrch = 1: GoTo rp
        End If
    Next n

    If (lMax_Out < lSrch) Then lMax_Out = lSrch: sSubStr_Out = sSrch
    If (lMin_In = i + lSrch - 1) Then GoTo ex Else lSrch = lSrch + 1
Loop

ex: If (lMax_Out <> 0) Then pv_MainSubString = True
End Function
'--------------------------------------------------------------------------------------------------
Private Function MainSubString(rng As Range) As String
Dim aStr$(), sMin$, lMin&, lMax&
    If Not pv_Rng_GetUniqStrings(rng, lMin, sMin, aStr) Then Exit Function
    pv_MainSubString lMin, sMin, aStr, lMax, MainSubString
End Function
'==================================================================================================