VBA Excel 实现单元格内多行内容的文字处理方法
在Excel中有很多的函数可以作用于单元格,但是其对单元格整体进行操作,因此单元格数据最好只有一行,这样Excel函数才能运行正确。但是有时候一个单元格内多行字符串的处理,Excel并没有很好地进行支持。因此对于单元格中的多行文字的处理,我来提供一种简单的代码解决方案,其中最核心的就是单元格内的多行遍历。
而我写这篇博客的原因就是这方面的需求还没有人写过类似的博客,但是该类型的需求有时还比较多,如果有什么问题欢迎进行讨论。但是,VBA确实不是一门非常友好的语言,它的优势仅仅在于和Excel的良好的兼容性。
文章目录
- VBA Excel 实现单元格内多行内容的文字处理方法
- 多行遍历判定方法
- 一些简单VBA功能
- 删除带删除线的文本
- 判断字符串是否以某个指定字符串结束
- 过滤仅留下每行字符串中以.c和.htm为结尾的字符串(以..结尾可以更换)
- 将两列单元格内数据进行合并,左列只保留.htm和.c结尾的单元格内的行,并将两列中带有删除线的文本删除,并在指定单元格下将数据写入。
多行遍历判定方法
当单元格含有多行数据,那么换行符一定存在于行之间,因此寻找换行符便可以分开每一行。
下面的Demo实现了将Sheet1 中的 Cells(1,1) 中的多行元素分割开来,并存储到arr中。其中Chr(10)便指的是换行符,也就是Excel中的alt+enter。
Sub Demo()
Set a = Sheets("Sheet1").Cells(1, 1) '设置a的值
Dim temp, letter As String '设置一些中间变量
Dim arr(50) As String '设置最终的结果变量arr
Dim j As Integer '设置一个标记
j = 1
For i = 1 To Len(str)
temp = temp & Mid(a, i, 1)
letter = Mid(a, i, 1)
If letter = Chr(10) Or i = Len(str) Then '判断字符是否是换行符或者判断该单元格是否结束
arr(j) = temp
temp = ""
j = j + 1
End If
Next i
End Sub
一些简单VBA功能
删除带删除线的文本
Function del_text(x As Range) 'This function can delete specific text with strikethrough from specific cell
Dim c, d
Dim temp As String
Dim str As String
For Each rng In x
c = rng.Characters.Count
d = 1
str = ""
Do Until d > c
If Cells(rng.Row, rng.Column).Characters(Start:=d, Length:=1).Font.Strikethrough = False Then '判断该字符是否被添加删除线
str = str & Mid(rng, d, 1)
End If
d = d + 1
Loop
rng.Value = str
Next
End Function
判断字符串是否以某个指定字符串结束
该函数的两个参数分别为 x 需要判断的字符串, match是判断的字符串。 其功能是判断x字符串是否以match结束
Function Endwith(x As String, match As String) 'This function is used to verify if String x is end with String match
If x Like match Then
Endwith = True
Else
Endwith = False
End If
End Function
过滤仅留下每行字符串中以.c和.htm为结尾的字符串(以…结尾可以更换)
Function filter(x As Range) 'This function is used to filter .c and .htm file for each line
Dim temp As String
Dim str, a As String
str = ""
For Each rng In x
a = Cells(rng.Row, rng.Column).Value
For i = 1 To Len(a)
letter = Mid(a, i, 1)
If letter = Chr(10) Or i = Len(a) Then
If i = Len(a) Then
temp = temp & letter
If (Endwith(temp, "*.htm")) Or (Endwith(temp, "*.c")) Then
str = str & temp
End If
Else
If (Endwith(temp, "*.htm")) Or (Endwith(temp, "*.c")) Then
str = str & temp
End If
temp = temp & letter
temp = ""
End If
End If
temp = temp & letter
Next i
Next
filter = str
End Function
将两列单元格内数据进行合并,左列只保留.htm和.c结尾的单元格内的行,并将两列中带有删除线的文本删除,并在指定单元格下将数据写入。
具体实现的效果如下图所示。
Sub Merge_multiple(x As Range, y As Range) 'This function is to filter some infomations indicated and put them together, And put them in the same position of the cell chosen
Dim wb As Object
Dim st As Object
Dim xx, yy As Range
Dim xstr, ystr As String
Dim rr As Integer
Dim sel As Range
Dim row_num As Integer
row_num = Selection.Row
col_num = Selection.Column
rr = x.rows.Count
If x.rows.Count <> y.rows.Count Then
MsgBox "The variables you enter don't have the same column"
End If
For i = 1 To rr
Call del_text(x.rows(i))
Call del_text(y.rows(i))
ystr = y.rows(i)
xstr = filter(x.rows(i))
xstr = ystr & xstr
Cells(row_num + i - 1, col_num).Value = xstr
xstr = ""
ystr = ""
Next i
End Sub