从字段按分号或句号分段提取字符串，并存储到其他表中的实例

时　间:2010-09-11 12:47:59
作　者:pzszdy   ID：4169  城市：绵阳
摘　要:字符 分段 提取
正　文:

有时候一个字段里面存储了几句话，我们想按分号或者句号，分段提取，并存储到另外的表中，可以用这样的方法，我是初学，也许还有更好的方法，请大家指教。

代码是我的一个实例，并不通用：

Option Compare Database

Private Sub Command0_Click()
Dim strCf(1 To 10) As String '分段处罚
Dim strsqlCfjg As String '查询到的处罚结果
Dim intWzfh '分号所在位置
Dim intWzjh '句号所在位置
Dim intWzks '开始位置
Dim intCsfh As Integer '分号开始位置

       Dim ssql As String
        ssql = "Delete * FROM 处罚分段;"
        CurrentDb.Execute ssql
        ssql = "Insert INTO 处罚分段 ( 案件编号)   VALUES('" & [Forms]![窗体1].[List1] & "') "
        CurrentDb.Execute ssql

     Dim sql As String
     Dim rs As ADODB.Recordset
   
   
     sql = "Select 案件基本情况.处罚结果 FROM 案件基本情况  Where 案件基本情况.案件编号='" & [Forms]![窗体1].[List1] & "'"
     Set rs = New ADODB.Recordset
     rs.CursorLocation = adUseClient
     rs.Open sql, CurrentProject.Connection, adopendynaset, adLockOptimistic
    
    
    
If rs!处罚结果 <> "" Then
       strsqlCfyj = rs!处罚结果
     
    ' strsqlCfjg = "Select 案件基本情况.处罚结果 FROM 案件基本情况 Where 案件基本情况.案件编号='" & [Forms]![工作台].[List116] & "'"
    ' CurrentDb.Execute trsqlCfjg
      strsqlCfyj = Replace(Replace(strsqlCfyj, Chr(10), ""), Chr(13), "")
      strsqlCfyj = Replace(strsqlCfyj, ";", "；")
      strsqlCfyj = Replace(strsqlCfyj, ".", "。")
      strsqlCfyj = Replace(strsqlCfyj, ",", "，")
  
    k = Len(strsqlCfyj)
    intCsfh = 0
    For l = 1 To k
        If Mid(strsqlCfyj, l, 1) = "；" or Mid(strsqlCfyj, l, 1) = "。" Then
        intCsfh = intCsfh + 1
        End If
    Next
 
     intWzfh = 1
     intWzks = 1
    
     For I = 1 To intCsfh '分、句号次数
       intWzfh = IIf(InStr(intWzfh, strsqlCfyj, "；") = 0, InStr(intWzfh, strsqlCfyj, "。"), InStr(intWzfh, strsqlCfyj, "；"))
      ' intWzjh = InStr(intWzfh, strsqlCfyj, "。")
      
         For J = intWzks To intWzfh
           strCf(I) = strCf(I) + Mid(strsqlCfyj, J, 1)
         Next
       intWzfh = intWzfh + 1
       intWzks = intWzfh
       strCf(I) = Trim(strCf(I))
        'ssql = "Insert INTO 处罚分段 ( 处罚1)   VALUES('" & strCf(I) & "') "
        'CurrentDb.Execute ssql
        ssql = "Update 处罚分段 SET 处罚分段.处罚" & I & " = '" & strCf(I) & "'  Where  处罚分段.案件编号 = '" & [Forms]![窗体1].[List1] & "'"
        CurrentDb.Execute ssql
      MsgBox strCf(I)
    Next

End If
End Sub