VBA Excel 单元格内多行内容的文字处理方法

VBA Excel 实现单元格内多行内容的文字处理方法

在Excel中有很多的函数可以作用于单元格，但是其对单元格整体进行操作，因此单元格数据最好只有一行，这样Excel函数才能运行正确。但是有时候一个单元格内多行字符串的处理，Excel并没有很好地进行支持。因此对于单元格中的多行文字的处理，我来提供一种简单的代码解决方案，其中最核心的就是单元格内的多行遍历。
而我写这篇博客的原因就是这方面的需求还没有人写过类似的博客，但是该类型的需求有时还比较多，如果有什么问题欢迎进行讨论。但是，VBA确实不是一门非常友好的语言，它的优势仅仅在于和Excel的良好的兼容性。如果不考虑这些，Python欢迎你哦！

---

---

多行遍历判定方法

当单元格含有多行数据，那么换行符一定存在于行之间，因此寻找换行符便可以分开每一行。
下面的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