excel VBA 数据提取从某一列中提取所需内容区间,并赋值给另一列

180it 2019-09-25 PM 1098℃ 0条

笔者最近在做一个数据库项目,其中需要从EXCEL中提取关键字段。提取内容如下图所示,需要将图中加粗部分单独提出后进行去噪处理。如果通过word处理,文字量小的时候尚可实现,但几十万字的处理量很容易就造成假死。因此采用了EXCEL进行数据处理。
在这里插入图片描述

代码如下:功能是将B列中的数据筛选后存入C列

Sub 提取内容()
Dim searchtext
Dim textlong
Dim str_start
Dim str_end

For i = 1 To 2000
searchtext = Worksheets("sheet1").Range("B" & i).Value
textlong = Len(Worksheets("sheet1").Range("B" & i).Value)
'————————————————————————————确定提取的字符区间

If InStr(searchtext, "解决") <> 0 Then
str_start = InStr(searchtext, "解决")
str_end = InStr(searchtext, "问题")

'————————————————————————————避免B列出现不含有所要提取内容时报错
If str_start - str_end - 2 > 0 Then
Worksheets("B60J7摘要").Range("c" & i).Value = Mid(searchtext, str_start + 2, str_start - str_end - 2)
End If
'————————————————————————————提取B列中的内容至C列

ElseIf InStr(searchtext, "问题") <> 0 Then
Worksheets("sheet1").Range("c" & i).Value = Right(searchtext, str_start + 2, str_start - str_end - 2)
ElseIf searchtext = "" Then
Worksheets("sheet1").Range("c" & i).Value = ""
Else
Worksheets("sheet1").Range("c" & i).Value = "不含有"
End If

Next
End Sub

注:由于要提取的内容中,必然以“解决”开头,以“问题”结尾,因此可采用上述代码处理。提取结果如图所示。

支付宝打赏支付宝打赏 微信打赏微信打赏

如果文章或资源对您有帮助,欢迎打赏作者。一路走来,感谢有您!

标签: none

excel VBA 数据提取从某一列中提取所需内容区间,并赋值给另一列