Extraiga dos dígitos únicos y coloque dos dígitos únicos no duplicates en la siguiente columna inmediata, separados por tubería

Tengo inputs similares en 1000 celdas de la columna A en donde cada valor tiene primero dos caracteres seguidos por algunos numbers y hay múltiples valores separados por tubería como se muestra a continuación:

Entrada (columna A)

Celda A1 = US6690414B2 | US420416T | CN1256694C | CN1401109A | DE60137365D1

Celda A2 = EP1346328A1 | EP1346328B1 | ES2320416T3 | JP2004516556A

Celda A3 = US20020071032A1 | NZ2002048970A1

Salida deseada

Celda B1 = US | CN | Delaware

Celda B2 = EP | ES | JP

Celda B3 = US | Nueva Zelanda

PD – He verificado todas las preguntas similares, pero esto no ha sido respondido antes, por lo tanto preguntando. Gracias por adelantado.

Usó este código

Sub main2() Dim strng As Variant With CreateObject("Scripting.Dictionary") For Each cell In Columns(1),SpecialCells(xlCellTypeConstants) ... Next cell For Each strng In Split(Replace(cell, " ", ""), "|") .Item(Left(strng, 2)) = .Item(Left(strng, 2)) & "|" & strng & "|" Next Range("B1").Resize(,.count).Value = ".Items" With cell.Offset(,1).Resize(.Count) .Replace "||", "--" .Replace "|", "" .Replace "--", " | " End With End With End Sub