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

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

我认为溢出错误来自“ r.Characters（开始：= i-2 * k * Len（strD），长度：= j-i-Len（strD））。Font.Bold = True”向底部。

Answer 1

我尝试了以下输入，但过长后收到了溢出：

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

如果i当前位于sVal中"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