Question

我有一个宏，它根据边框组合范围内的单元格。它工作正常，直到我意识到它没有考虑到文本的属性（特别是粗体字）。我将第二部分添加到宏中，由于某种原因我得到了溢出。这是宏：

    Sub TestMacro()
    Dim c As Range
    Dim outputText As String
    Dim strDelim As String
    strDelim = "XXXX"

    Selection.EntireColumn.Offset(0, 1).Clear
    Selection.EntireColumn.Offset(0, 1).Insert
    Selection.EntireColumn.Offset(0, 1).Font.Bold = False


    For Each c In Selection
        If c.Borders(xlEdgeTop).LineStyle <> xlNone Then
            If outputText <> "" Then
                c.Offset(-1, 1).Value = outputText
                FixBold c.Offset(-1, 1), strDelim
            End If
            outputText = IIf(c.Font.Bold, strDelim, "") & c.Value & IIf(c.Font.Bold, strDelim, "")
        Else
            outputText = outputText & " " & IIf(c.Font.Bold, strDelim, "") & c.Value & IIf(c.Font.Bold, strDelim, "")
        End If
    Next c

    If outputText <> "" Then
        With Selection.Cells(Selection.Cells.Count).Offset(0, 1)
            .Value = outputText
            FixBold .Cells(1), strDelim
        End With
    End If

End Sub


Sub FixBold(r As Range, strD As String)
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim sVal As String
    Dim s As Variant
    Dim boolBold As Boolean

    sVal = Replace(r.Value, strD & " " & strD, " ")
    r.Value = Replace(r.Value, strD, "")
    i = InStr(1, sVal, strD)
    While i > 0
        j = InStr(i + 1, sVal, strD)
        r.Characters(Start:=i - 2 * k * Len(strD), Length:=j - i - Len(strD)).Font.Bold = True
        i = InStr(j + 1, sVal, strD)
        k = k + 1
    Wend
End Sub

我认为溢出错误来自＆＃34; r.Characters（开始：= i - 2 * k * Len（strD），长度：= j - i - Len（strD））。Font.Bold =真＆＃34;走向最底层。

Answer 1

我已经尝试了以下输入，并在很长时间后收到溢出：

简而言之，您的While条件会检查以确保i大于零，但i会在"XXXX"的出现次数之间切换而不是达到零。

如果i目前位于"XXXX"内sVal的最后一场比赛，j将被分配到下一场比赛的位置。但是，j将被分配到下一场比赛。由于没有一个，因此将其分配为0，从中可以再次将i分配给第一个匹配。这将持续到k超过32767，即有符号的16位整数的上限。

除此之外，您的代码目前所做的全部是使每个部分都变为粗体，无论相应的单元格是否为粗体。如果我有机会，我会在一个单独的答案中发布更新的代码，但我相信这至少解释了溢出错误。

我们将对此进行迭代，以确切了解发生了什么。

<强>初始化

sVal = "The quick brown XXXXFOXXXXX jumps over the lazy dog"
boolBold = undefined
i = 17
j = undefined (0)
k = undefined (0)
s = undefined (Empty)

第一次通过

sVal = "The quick brown XXXXFOXXXXX jumps over the lazy dog"
boolBold = False
i = 24
j = 23
k = 1
s = Empty

第二遍

sVal = "The quick brown XXXXFOXXXXX jumps over the lazy dog"
boolBold = False
i = 17
j = 0
k = 2
s = Empty

第三次通过

sVal = "The quick brown XXXXFOXXXXX jumps over the lazy dog"
boolBold = False
i = 24
j = 23
k = 3
s = Empty

第四遍

sVal = "The quick brown XXXXFOXXXXX jumps over the lazy dog"
boolBold = False
i = 17
j = 0
k = 4
s = Empty

Answer 2

以下代码应该更合适 - 请特别注意FixBold(r,rs)：

Option Explicit

Sub TestMacro()
    ' Assumes that:
    '   - Selection is contiguous

    Dim c As Range
    Dim outputText As String
    Dim groupedRange As Range
    Dim lastRow As Long

    Set groupedRange = Nothing                      ' The range which feeds outputText
    lastRow = Selection.Row + Selection.Rows.Count  ' The final row in Selection (relative to start)

    Selection.EntireColumn.Offset(0, 1).Clear
    Selection.EntireColumn.Offset(0, 1).Insert
    Selection.EntireColumn.Offset(0, 1).Font.Bold = False


    For Each c In Intersect(Selection.Rows.Cells, Selection.Columns(1).EntireColumn)
        If c.Borders(xlEdgeTop).LineStyle <> xlNone Then
            If outputText <> "" Then
                c.Offset(-1, 1).Value = outputText
                FixBold c.Offset(-1, 1), groupedRange
            End If
            outputText = c.Value
            Set groupedRange = c
        Else
            outputText = outputText & " " & c.Value
            ' Assign to the group
            If Not groupedRange Is Nothing Then
                ' Set -- combine with c
                Set groupedRange = Union(groupedRange, c)
            Else
                ' Unset -- Union(a,b) with null parameters throws an error
                Set groupedRange = c
            End If
        End If
    Next c

    If outputText <> "" Then
        With Selection.Cells(Selection.Cells.Count).Offset(0, 1)
            .Value = outputText
            FixBold .Cells(1), groupedRange
        End With
    End If

End Sub

Sub FixBold(r As Range, rs As Range)
    ' Iterate through the cells in supporting range rs
    ' For each cell in rs which is formatted bold,
    '   update the corresponding formatting in r
    ' We won't need a string delimiter here

    If rs Is Nothing Then Exit Sub  ' Ignore this if rs wasn't given

    Dim c As Range  ' Cell iterator variable
    Dim l As Long   ' Cell length
    Dim lt As Long  ' Elapsed length (remember to include space between cells)

    lt = 1

    For Each c In rs.Cells

        l = Len(c.Text)
        If c.Font.Bold And l > 0 Then
            r.Characters(lt, l).Font.Bold = True
        End If
        lt = lt + l + 1

    Next c

End Sub

Excel VBA宏给我一个溢出错误6

2 个答案: