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

有人知道这样做的好方法吗？它不一定必须在VBA中完成。我可以在SQLExpress中导入表，因此也欢迎使用SQL解决方案。

我希望这是足够的信息。让我知道您是否需要更多。

谢谢。

Answer 1

我汇总的SQL解决方案使用了一个称为DelimitedSplit8K的T-SQL函数，其功能类似于您正在使用的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

根据邮政编码区域将包含邮政编码前缀列表的行分成多行

2 个答案: