excel 拆分单元格值并保留新工作簿上的格式

kmbjn2e3 于 2023-04-22 发布在其他

关注(0)|答案(1)|浏览(156)

我试图选择一个充满文本的单元格，并将文本拆分/解析到新工作簿中的各行，同时保持源字体格式（即粗体文本）。
在下面的代码中，我尝试对行单元格值执行拆分，我知道这将删除我的格式和粗体。如果我的粗体文本单独在一个单元格中，这是可行的，但是当我在同一个单元格中有粗体和非粗体文本时，我的整个输出最终都是粗体的。如果我省略粗体字体更改，那么我的单元格就缺少粗体字体。
是否有方法在保持单元格格式的同时执行拆分？

Sub Macro1()

    Dim InputData As Range
    Dim arr() As String
    Dim NewBook As Workbook
    Dim shnew As Worksheet

    counter = 0
    counter2 = 0
    Boxtitle = " Find and Bold"""

    Set InputData = Application.Selection.Range("A1")
    Set InputData = Application.InputBox("Select cell Range: ", Boxtitle, InputData.Address, Type:=8)

    'Create new workbook instance
    Set NewBook = Workbooks.Add
    Set shnew = NewBook.Worksheets.Add

    ' Loop through range and split on delimitter and add to array
    For Each x In InputData.Rows
        If InputData.Cells(1 + counter, 1).Font.Bold = False Then
            arr = Split(InputData.Cells(1 + counter, 1), ". ")
            counter = counter + 1
            For Each i In arr
                shnew.Cells(1 + counter2, 1) = i
                counter2 = counter2 + 1
            Next
        Else
            arr = Split(InputData.Cells(1 + counter, 1), ". ")
            counter = counter + 1
            For Each i In arr
                shnew.Cells(1 + counter2, 1).Font.Bold = True
                shnew.Cells(1 + counter2, 1) = i
                counter2 = counter2 + 1
            Next
        End If
    Next

End Sub

excel

来源：https://stackoverflow.com/questions/74022159/split-cell-value-and-keep-formatting-on-new-workbook

1条答案

按热度按时间

tktrz96b1#

这将被证明不是那么容易。AFAIK你最好的办法是循环每个字符。一种方法是：

Sub Test()

Dim s As Range: Set s = Range("A1")
Dim c As Range: Set c = Range("B1")
Dim r As Variant, x As Long, y As Long

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = ".*?(?:\. |$)"
    If .Test(s.Value) Then
        Set r = .Execute(s)
        For Each Match In r
            c.Value = Match
            y = Match.FirstIndex
            For x = 1 To Len(Match)
                c.Characters(x, 1).Font.Bold = s.Characters(y + x, 1).Font.Bold = True
                c.Characters(x, 1).Font.Italic = s.Characters(y + x, 1).Font.Italic = True
                c.Characters(x, 1).Font.Strikethrough = s.Characters(y + x, 1).Font.Strikethrough = True
                c.Characters(x, 1).Font.Name = s.Characters(y + x, 1).Font.Name
                c.Characters(x, 1).Font.Color = s.Characters(y + x, 1).Font.Color
                c.Characters(x, 1).Font.Size = s.Characters(y + x, 1).Font.Size
                c.Characters(x, 1).Font.Underline = s.Characters(y + x, 1).Font.Underline
            Next
            Set c = c.Offset(1, 0)
        Next
    End If
End With

End Sub

正如你所注意到的，我添加了更多的字体特征，而不仅仅是粗体。相应地擦除/添加。显然，我有范围变量进行测试。应用适当的变量来适应你的情况。一些测试结果：

赞(0）回复(0）举报 2023-04-22

我来回答

excel 拆分单元格值并保留新工作簿上的格式

1条答案

相关问题

热门标签

最新问答