Question

我有代码从第一个工作表中的单元格遍历字符串中的每个字符，检查它是否格式化（粗体，下划线，彩色）并将我的自定义标记（例如。{b}和{eb}）放入正确的位置并将其粘贴到第二个工作表中的另一个单元格。我无法弄清楚如何让我的代码出现在正确的位置。我尝试了LEFT和RIGHT，MID功能，但没有成功。

Dim b, u, c As Boolean
Dim x As Integer

b = False
u = False
c = False

Dim bytes() As Byte
Dim example As String

example = FCTitle.Offset(0, 1).Value
bytes = example

   If FCTitle.Offset(0, 1).Value <> "" Then
    Debug.Print "start"

       For x = LBound(bytes) To UBound(bytes) Step 2
            With FCTitle.Offset(0, 1).Characters(x, 1)

               If .Font.Bold = True And b = False Then
                    s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{b}"
                    b = True
                    Debug.Print s1Title.Offset(-1, 1).Value

            End If
            If .Font.Underline = 2 And u = False Then
                s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{u}"  '
               u = True
                Debug.Print s1Title.Offset(-1, 1).Value
            End If
            If .Font.ColorIndex > 0 And .Font.ColorIndex <> 1 And c = False Then
                s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{c}" ' & Right(bytes, UBound(bytes) - x)
               c = True
                Debug.Print s1Title.Offset(-1, 1).Value
            End If
            If (.Font.ColorIndex < 0 Or .Font.ColorIndex = 1) And c = True Then
            s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{ec}"
                c = False
                Debug.Print s1Title.Offset(-1, 1).Value
            End If
            If .Font.Underline <> 2 And u = True Then
                s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{eu}"
                u = False
                Debug.Print s1Title.Offset(-1, 1).Value
            End If
            If .Font.Bold = False And b = True Then
                s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{eb}"
                b = False
                Debug.Print s1Title.Offset(-1, 1).Value
            End If
            If Asc(.Text) = 10 Then
                s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & .Text
                Debug.Print s1Title.Offset(-1, 1).Value
            End If

        End With

      Next x
        If c = True Then
        s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{ec}"
        Debug.Print s1Title.Offset(-1, 1).Value
        c = False

        End If
        If u = True Then
        s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{eu}"
        Debug.Print s1Title.Offset(-1, 1).Value
        u = False

        End If
        If b = True Then
        s1Title.Offset(-1, 1).Value = s1Title.Offset(-1, 1).Value & "{eb}"
        Debug.Print s1Title.Offset(-1, 1).Value
        b = False

        End If
        Debug.Print "koniec"     
    End If

到目前为止，字符串中每次更改后在控制台中打印的值如下所示。 Word＆＃34; SUPER＆＃34;是粗体，下划线和红色，所以我的预期输出应该是＆＃34; {b} {u} {c} SUPER {eb} {eu} {ec} aaa {b} {u} {c} SUPER {eb } {EU} {EC}＆＃34 ;.对不起，如果我做错了，这是我的第一篇帖子。

start
SUPER  aaa  SUPER{b}
SUPER  aaa  SUPER{b}{c}
SUPER  aaa  SUPER{b}{c}{ec}
SUPER  aaa  SUPER{b}{c}{ec}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}{ec}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}{ec}{eu}
SUPER  aaa  SUPER{b}{c}{ec}{u}{c}{eu}{ec}{eb}{b}{c}{u}{ec}{eu}{eb}
koniec

Answer 1

这对我有用（写成UDF）

某些字符属性有点棘手 - 例如Bold可以是null，False或True，而ColorIndex不是看起来很可靠。

Function Coded(r As Range)
    Dim rv As String, b As Boolean, c As Boolean, u As Boolean
    Dim bC As Boolean, cC As Boolean, uC As Boolean
    Dim i As Long, txt

    For i = 1 To Len(r.Value)
        'get this character's properties
        With r.Characters(i, 1)
            bC = Not (IsNull(.Font.Bold) Or .Font.Bold = False)
            uC = (.Font.Underline = 2)
            cC = (.Font.ColorIndex <> -4105) '-4105=automatic
            txt = .Text
        End With
        'opening or closing any tags?
        If c <> cC Then
            rv = rv & IIf(cC, "{c}", "{ec}")
            c = cC
        End If
        If b <> bC Then
            rv = rv & IIf(bC, "{b}", "{eb}")
            b = bC
        End If
        If u <> uC Then
            rv = rv & IIf(bC, "{u}", "{eu}")
            u = uC
        End If
        rv = rv & txt
    Next i

    'close any open tags
    If b Then rv = rv & "{eb}"
    If c Then rv = rv & "{ec}"
    If u Then rv = rv & "{eu}"

    Coded = rv
End Function

将标签插入单元格中的字符串中间

1 个答案: