数据整理（提取年份）

实例需求：原始数据在A列，先需求整理为C列。

• 所有年份补足4位数字
• 原始数据中分割符不规范，有全角分号，半角分号和半角句号
• 有的数据以分隔符结尾

示例代码如下。

Sub demo()
    Dim res()
    cnt = 1
    arr = [a1].CurrentRegion.Value
    For i = 2 To UBound(arr)
        txt = VBA.Replace(arr(i, 1), "；", ";")
        txt = VBA.Replace(txt, ".", ";")
        msg = VBA.Split(txt, ";")
        Debug.Print txt
        For j = LBound(msg) To UBound(msg)
            If Len(msg(j)) > 0 Then
                yrs = VBA.Split(msg(j), "-")
                If UBound(yrs) = 0 Then
                    ReDim Preserve res(1 To cnt)
                    res(cnt) = yrs(0)
                    cnt = cnt + 1
                Else
                    If Len(yrs(1)) = 2 Then yrs(1) = Left(yrs(0), 2) & yrs(1)
                    ReDim Preserve res(1 To cnt + 1)
                    res(cnt) = yrs(0)
                    res(cnt + 1) = yrs(1)
                    cnt = cnt + 2
                End If
            End If
        Next
    Next
    [d:d].Clear
    [d2].Resize(UBound(res), 1).Value = Application.Transpose(res())
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

【代码解析】
第4行代码将原始数据读入数组中。
第5~26行代码循环处理每行数据。
第6~7行代码将分隔符统一替换为半角分号（也可以使用其他分隔符），这样后续拆分代码中无需再判断分隔符。
第8行代码使用半角分号拆分数据。
第10~25行代码循环处理每段数据。
第11行代码判断数据长度，如果为零，说明该行数据以分隔符结尾，跳过后续处理过程。
第12行代码将数据以减号为分隔符拆分年份。
如果拆分后yrs数组中只有一个元素，那么说明该段数据为单个年份，第14行代码声明动态数组，第15行代码将年份写入数组中。
如果拆分后yrs数组中有多个元素，那么第18行代码判断第二年份的长度，如果为两位数字，则需要补足4位。
第19行代码声明动态数组，第20~21行代码将年份写入数组中。
第27行代码清空D列。
第28行代码将数据写入工作表中。

示例代码运行结果如下图所示。