Разделение строк, содержащих список префиксов почтовых индексов, на несколько строк на основе области почтовых индексов

Question

У меня есть таблица с несколькими столбцами данных, один из которых содержит список различных комбинированных префиксов почтовых индексов в одной строке.

Вот пример макета таблицы:

+------+-----------------------------+
| Col1 |            Col2             |
+------+-----------------------------+
| a    | AB10; AB11;  DD10; DD9      |
| b    | S5; SS7; AA1; AA4           |
| c    | AB33; AB34; AB36; GG10; GS9 |
+------+-----------------------------+

Я хочу разделить префиксы почтового индекса на несколько строк в зависимости от области почтового индекса, как показано ниже:

+------+------------------+
| Col1 |       Col2       |
+------+------------------+
| a    | AB10; AB11       |
| a    | DD10; DD9        |
| b    | S5               |
| b    | SS7              |
| b    | AA1; AA4         |
| c    | AB33; AB34; AB36 |
| c    | GG10             |
| c    | GS9              |
+------+------------------+

Я нашел решение VBA, которое разделяется, используя точку с запятой в качестве разделителя, но не так, как мне нужно.

Sub splitByColB()
    Dim r As Range, i As Long, ar
    Set r = Worksheets("Sheet1").Range("B4").End(xlUp)
    Do While r.Row > 1
        ar = Split(r.Value, ";")
        If UBound(ar) >= 0 Then r.Value = ar(0)
        For i = UBound(ar) To 1 Step -1
            r.EntireRow.Copy
            r.Offset(1).EntireRow.Insert
            r.Offset(1).Value = ar(i)
        Next
        Set r = r.Offset(-1)
    Loop
End Sub

Я мог бы импортировать таблицу в SQLExpress, поэтомуРешение SQL также будет приветствоваться.

Answer 1

Решение SQL, которое я собрал, использует функцию T-SQL под названием DelimitedSplit8K , которая работает как используемая вами функция VB SPLIT.

-- Sample Data
DECLARE @table TABLE (Col1 CHAR(1) UNIQUE, Col2 CHAR(200));
INSERT @table (Col1,Col2) VALUES ('a','AB10; AB11;  DD10; DD9'),
  ('b','S5; SS7; AA1; AA4'),('c','AB33; AB34; AB36; GG10; GS9');

WITH xx(Col1,i,Pre) AS
(
  SELECT      t2.Col1, ss.Item+'', f.Pre
  FROM        @table AS t2
  CROSS APPLY dbo.DelimitedSplit8K(t2.Col2,';')                          AS s
  CROSS APPLY (VALUES(RTRIM(LTRIM(s.item))))                             AS ss(Item)
  CROSS APPLY (VALUES(SUBSTRING(ss.Item,0,PATINDEX('%[0-9]%',ss.Item)))) AS f(Pre)
)
SELECT   xx.col1, col2 = STUFF((SELECT '; '+i 
                                FROM    xx AS x2 
                                WHERE   x2.Col1 = xx.Col1 AND x2.Pre = xx.Pre
                                FOR XML PATH('')),1,2,'')
FROM     xx
GROUP BY col1, xx.Pre;

Возвращает:

col1 Col2
---- ----------------------
a    AB10; AB11
a    DD10; DD9
b    AA1; AA4
b    S5
b    SS7
c    AB33; AB34; AB36
c    GG10
c    GS9

Я также собрал решение, которое работает с SQL Server 2017, которое будет чище (на случай обновления или других или использования 2017 года.)

-- Sample Data
DECLARE @table TABLE (Col1 CHAR(1) UNIQUE, Col2 CHAR(200));
INSERT @table (Col1,Col2) VALUES ('a','AB10; AB11;  DD10; DD9'),
  ('b','S5; SS7; AA1; AA4'),('c','AB33; AB34; AB36; GG10; GS9');

SELECT t.Col1, split.item
FROM @table AS t
CROSS APPLY
(
  SELECT      STRING_AGG(ss.Item,'; ') WITHIN GROUP (ORDER BY ss.Item)
  FROM        @table AS t2
  CROSS APPLY STRING_SPLIT(t2.Col2,';') AS s
  CROSS APPLY (VALUES(TRIM(s.[value]))) AS ss(Item)
  WHERE       t.Col1 = t2.col1
  GROUP BY    SUBSTRING(ss.Item,0,PATINDEX('%[0-9]%',ss.Item))
) AS split(item);

Answer 2

вы можете использовать вложенные dictionary объекты:

Sub splitByColB()
    Dim r As Range, ar, val1, val2, prefix As String
    Dim obj1 As Object, obj2 As Object

    Set obj1 = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")

        For Each r In .Range("B2:B4")
            Set obj2 = CreateObject("Scripting.Dictionary")
            With obj2
                For Each val2 In Split(Replace(r.Value2, " ", vbNullString), ";")
                    prefix = GetLetters(CStr(val2))
                    .Item(prefix) = .Item(prefix) & val2 & " "
                Next
            End With
            Set obj1.Item(r.Offset(, -1).Value2) = obj2
        Next

        .Range("A2:B4").ClearContents
        For Each val1 In obj1.keys
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(obj1(val1).Count).Value = val1
            For Each val2 In obj1(val1).keys
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = obj1(val1)(val2)
            Next
        Next
    End With
End Sub

Function GetLetters(s As String) As String
    Dim i As Long
    Do While Not IsNumeric(Mid(s, i + 1, 1))
        i = i + 1
    Loop
    GetLetters = Left(s, i)
End Function