请问怎么提取出字符串中的年份？

Question

表中有一个表示政府机关公文的文号字段，内容类似以下
1999年4月9日        应能取出1999
冀[1997]第1号       应能取出1997
冀(1987)第123号    应能取出1987
冀<1998>第234号    应能取出1998 
冀干字(92)      －－应能取出1992
.........现在我要取出这些行中的年份，写到另一个字段中，该怎么写代码呢？

Answer 1

简单好理解的代码：function GetYear(byval s as string) as string
    dim i as long
    for i=1900 to 2008
        if instr(s,i)>0 then
            GetYear=i
            exit function
        end if
    next
end function当然效率可能不是太好......

Answer 2

'从一个textbox里取出来放到另一个textbox中，你可以改一下改成你需要的
Private Sub Command1_Click()
    Dim strTxt As String
    Dim nLen As Integer
    Dim i As Integer
    Dim arrStr() As String
    Dim strType As String
    
    strTxt = Text1.Text
    nLen = Len(strTxt)
    ReDim arrStr(nLen)
    
    For i = 1 To nLen
        arrStr(i) = Mid(strTxt, i, 1)   '一个个字符取出来
        If IsNumeric(arrStr(i)) Then    '判断是不是数字
            strType = strType & arrStr(i)
        Else
            If strType <> "" And (Len(strType) = 2 Or Len(strType) = 4) Then
                If Len(strType) = 2 Then
                    strType = "19" & strType    '这个要根据你的要求来决定19或18...
                    Exit For
                ElseIf Len(strType) = 4 Then
                    If Val(strType) <= 2008 Then    '年份2008以前
                        Exit For
                    Else
                        strType = ""
                    End If
                Else
                    strType = ""
                End If
            End If
        End If
    Next i
    If i <> (nLen + 1) Then  '如相等则没有找到符合条件的年份
        Text2.Text = strType
    End If
End Sub

Answer 3

'从一个textbox里取出来放到另一个textbox中，你可以改一下改成你需要的
Private Sub Command1_Click()
    Dim strTxt As String
    Dim nLen As Integer
    Dim i As Integer
    Dim arrStr() As String
    Dim strType As String
    
    strTxt = Text1.Text
    nLen = Len(strTxt)
    ReDim arrStr(nLen)
    
    For i = 1 To nLen
        arrStr(i) = Mid(strTxt, i, 1)   '一个个字符取出来
        If IsNumeric(arrStr(i)) Then    '判断是不是数字
            strType = strType & arrStr(i)
        Else
            If strType <> "" And (Len(strType) = 2 Or Len(strType) = 4) Then
                If Len(strType) = 2 Then
                    strType = "19" & strType    '这个要根据你的要求来决定19或18...
                    Exit For
                ElseIf Len(strType) = 4 Then
                    If Val(strType) <= 2008 Then    '年份2008以前
                        Exit For
                    Else
                        strType = ""
                    End If
                Else
                    strType = ""
                End If
            End If
        End If
    Next i
    If i <> (nLen + 1) Then  '如相等则没有找到符合条件的年份
        Text2.Text = strType
    End If
End Sub

Answer 4

就你上面给出的数据使用正则表达式可以有多种匹配方式，例如：Dim myRegExp
Set myRegExp = New RegExp
myRegExp.Pattern = "[12]?[09]?[057689]\d"或者：
Dim myRegExp
Set myRegExp = New RegExp
myRegExp.Pattern = "[\n[(<]((\d{2}){1,2})"
最后一个最特殊，可通过位数判断在前面增加“19”格式太乱，示例数据太少，规则不好定，自己看具体情况决定。

Answer 5

'引用Microsoft VBScript Regular Expressions 5.5.
Private Sub Command1_Click()    Dim regexpObj As New RegExp
    regexpObj.Pattern = "\d+"
    regexpObj.Global = True
    Dim matches, match, ret
s = "1999    年4月9日 " & vbCrLf & "冀[1997]第1号" & vbCrLf & "冀(1987)第123号 " & vbCrLf & "冀 <1998>第234号 " & vbCrLf & "冀干字 (92)"
    Set matches = regexpObj.Execute(s)
   
    For Each match In matches
    Select Case Len(match.Value)
    Case 2
    ret = ret & vbCrLf & "年份是: " & "19" & match.Value
    Case 4
    ret = ret & vbCrLf & "年份是: " & match.Value
   
      End Select
    Next
    MsgBox ret
End Sub

Answer 6

上面的"\d+"危险啊，如果字符串里是s = "1999    年4月9日 " & vbCrLf & "冀[1997]第1号" & vbCrLf & "冀(1987)第13号 " & vbCrLf & "冀 <1998>第34号 " & vbCrLf & "冀干字 (92)" 会误判，而两位的文件号是很可能出现的。总之楼主按自己实际情况定吧。