提取文号中的年份

AFree123

提取文号中的年份

1、E列单元格内为文号，文号一般为地名简称+单位简称+文号类别+[年份]+编码+号，但是2010年前的文号，中括号前面有3个汉字，2010年后的文号，中括号前面有4个汉字，也就是说中括号前面的汉字字数不一。

2、希望：在E列的文号中，首字为“藏”的，提取年份到G列对应单元格。首字不是“藏”的，无需提取。

可以总结为，提取E列首字为“藏”的、中括号内的数字，模拟结果详见G列。

请老师帮忙，如何使用VBA一键提取到列对应单元格。

谢谢！

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i
  arr = Range("e3:e" & Cells(Rows.Count, "e").End(xlUp).Row)
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1)
    If InStr(arr(i, 1), "藏") = 1 Then
      brr(i, 1) = Split(Split(arr(i, 1), "[")(1), "]")(0)
    End If
  Next
  [g3].Resize(UBound(brr, 1)) = brr
End Sub

grf1973

1. Sub 提取年份()
   
2.     arr = Range("e3:e" & [e65536].End(3).Row)
   
3.     With CreateObject("vbscript.regexp")
   
4.         .Pattern = "\d{4}"
   
5.         For i = 1 To UBound(arr)
   
6.             x = arr(i, 1)
   
7.             If InStr(x, "藏") = 0 Then arr(i, 1) = "" Else arr(i, 1) = .Execute(x)(0)
   
8.         Next
   
9.     End With
   
10.     [g3].Resize(UBound(arr)) = arr
    
11. End Sub
    

复制代码

AFree123

一把小刀闯天下 发表于 2018-7-24 15:01
Option Explicit

Sub test()

谢谢老师的帮助，真是快捷

lsc900707

1. Sub gj23w98()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 3 To UBound(arr)
   
4.         If Left(arr(i, 5), 1) = "藏" Then
   
5.             m = InStr(arr(i, 5), "[") + 1
   
6.             n = InStr(arr(i, 5), "]")
   
7.             arr(i, 7) = Mid(arr(i, 5), m, n - m)
   
8.         End If
   
9.     Next
   
10.     [a1].CurrentRegion = arr
    
11. End Sub
    

复制代码

lsc900707

附件供参考测试：

AFree123

lsc900707 发表于 2018-7-24 15:38

在实际工作中，由于各种原因文号命名规则有变化或者录入不规范，造成了不统一，一般使用半角中括号，但也有少量使用了全角中括号，还有的使用了括号、六角括号等等。

希望：E列单元格内为文号中，首字为“藏”的，提取年份

            首字不为“藏”的，无需提取。

可以总结为，提取E列首字为“藏”的、半角或全角中括号、括号、六角括号内的数字，模拟结果详见G列。

请老师帮忙再看看，如何使用VBA一键提取到列对应单元格。

谢谢！

AFree123

grf1973 发表于 2018-7-24 15:20

谢谢老师的帮助！
在实际工作中，由于各种原因文号命名规则有变化或者录入不规范，造成了不统一，一般使用半角中括号，但也有少量使用了全角中括号，还有的使用了括号、六角括号等等。
请教老师，该如何修改？

AFree123

一把小刀闯天下 发表于 2018-7-24 15:01
Option Explicit

Sub test()

谢谢老师的帮助！
在实际工作中使用，会提示：下标越界
可能是由于数据不规范
除了半角中括号，但也有少量使用了全角中括号，还有的使用了括号、六角括号等等。详见楼上的
提取文号中的年份22.rar
请教老师该如何修改VBa
谢谢！

duquancai

AFree123 发表于 2018-7-24 17:18
谢谢老师的帮助！
在实际工作中使用，会提示：下标越界
可能是由于数据不规范

写个VBA函数，你看可以不？？？

1. Function GYN(ByVal g As Range) As String
   
2.     With CreateObject("MSScriptControl.ScriptControl")
   
3.         .Language = "JavaScript"
   
4.         GYN = .eval("(a=/^藏.*?(\d{4})(?!\d)/.exec('" & g.Text & "'))?a[1]:'';")
   
5.     End With
   
6. End Function

复制代码