VBA：将行转换为列会导致 Excel 崩溃答案

【问题标题】：VBA: transpose rows into columns crashes ExcelVBA：将行转换为列会导致 Excel 崩溃
【发布时间】：2020-08-07 03:20:23
【问题描述】：

我在 1 列中有 1000 行数据，我需要根据每行粗体转换成列。粗体之间的行数不一致，与字符串值相同。

我创建了一个在测试前 100 行时完美运行的简单代码。但是当试图通过整个列表或其他一些部分（甚至 50 行）运行它时，它只是在运行时卡住了，所以我必须通过任务管理器非常出色（没有错误消息）。

Sub Transpose_by_bold()  
    Dim x, y As Integer

    y = 1
    For x = 1 To 2000
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = True Then y = 1
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = False Then
            Range("B" & x + 1).Cut Range("B" & x).Offset(0, y)
            Range("B" & x + 1).EntireRow.Delete

            y = y + 1
            x = x - 1
        End If
  Next x
End Sub

如果您能告诉我这里出了什么问题，我将不胜感激？

【问题讨论】：

我建议的一件事是向后循环，在删除行时始终建议这样做。
我正在寻找转置部分，但我什么也看不到。 “转置”是什么意思？
如果B1 是粗体而B2 不是，您将从x 中减去1，而x 将为零，这是不可能的。测试逻辑结果的一种方法是使用 F8 单步执行代码并观察值如何变化，以查看它是否在执行您想要的操作，然后再应用到 2000 行。

标签： excel vba

【解决方案1】：

您的代码当前处于挂起状态，因为一旦移动到列表末尾，X 就永远不会增加，因此它会进入无限循环。我没有测试过 FaneDuru 的代码，所以它可能是答案，但另一种选择是在你的代码中添加某种转义子句，在你不希望自然发生的某些情况下弹跳你在您的代码中 - 就像一个计数器 if range("b" & x).value = "" 在不为真时被重置，并且在达到某个最大值（例如，10 个背靠背空单元格）时将 X 设置为等于您的最大值（本例中为 2000）。

不要忘记，在出现此类奇怪的东西时，您可以使用 F8 单步执行代码并在局部变量窗口中查看 X 和 Y 的值 - 如果您这样做，X 卡住的事实就变成了很快就显现出来了。

样本计数器（效率不高，但可以）：

Sub Transpose_by_bold()
    Dim x, y As Integer
    Dim Counter as Integer
    y = 1
    For x = 1 To 2000
     If IsEmpty(Range("B" & x + 1)) Then
           Counter = Counter + 1
     Else
           Counter = 0
     End If
     If Counter > 9 Then
         x = 2001
     End If
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = True Then y = 1
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = False Then
            Range("B" & x + 1).Cut Range("B" & x).Offset(0, y)
            Range("B" & x + 1).EntireRow.Delete

            y = y + 1
            x = x - 1
        End If

  
  Next x
End Sub

另一种选择，我刚刚意识到（编辑注意这一点），将通过您感兴趣的列和工作表的使用范围的交叉来计算最大可能的行数，然后保留一个只检查的计数器您评估了多少行（由于您的 x=x-1 行，您现在的 X 计数器是您最终将获得多少行，而不是您查看了多少行）并运行您的主要 For 循环在总行数计数器上而不是在 X 上。

祝你好运！

【讨论】：

非常感谢！现在我知道了。完美运行
很高兴能帮上忙！

【解决方案2】：

请尝试下一个代码。我希望我能推断出你的代码的逻辑。特别是如何使用y（增加列以复制每次出现的范围）...如果逻辑正确，代码应该很快，一次删除所有行：

Sub Transpose_by_bold()
    Dim sh As Worksheet, x As Long, y As Long, rngDel As Range
    
    Set sh = ActiveSheet 'use here your sheet
    y = 1
    For x = 1 To 2000
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = True Then y = 1
        If Range("B" & x).Font.Bold = True And Range("B" & x + 1).Font.Bold = False Then
            Range("B" & x).Offset(0, y).Value = Range("B" & x + 1).Value
            If rngDel Is Nothing Then
                Set rngDel = Range("B" & x + 1)
            Else
                Set rngDel = Union(rngDel, Range("B" & x + 1))
            End If
            y = y + 1
        End If
    Next x
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete xlUp
End Sub

【讨论】：