vba - 请帮助停止无限循环

Question

我工作表上的每一行代表一次货币交易。每行的前 3 个单元格显示货币、日期和价格。之后的每 3 个单元格说明每个帐户在做什么。交易可以有任意数量的账户，因此行的长度不同。对于每笔交易（行），我希望每个账户都有自己独特的行，显示货币、日期、价格、买入/卖出、数量、账户。

**Example**


1          2       3    4   5    6    7    8    9  10  11   12  13
-------------------------------------------------------------------------------

EURUSD  1/1/13   1.30  Buy 100  acc1 Buy 1000 Acc2 Buy 100 acc3 Buy .....
EURUSD  2/1/13   1.31  Buy 1000 acc1 Buy 1000 Acc2 Buy 100 acc3 Buy .....
 .
 .
 .




**WOULD BECOME**

EURUSD  1/1/13   1.30 Buy 100  acc1
EURUSD  1/1/13   1.30 Buy 1000 Acc2
EURUSD  1/1/13   1.30 Buy 100  Acc3
.         .        .
.         .        .
.         .        .
EURUSD  2/1/13   1.31 Buy 1000 acc1
EURUSD  2/1/13   1.31 Buy 1000 acc2
EURUSD  2/1/13   1.31 Buy 100  acc3

我已经编写了一些代码（如下），我希望用它来实现这一点，但我认为我在那里有一个无限循环。对于我从第 4 列开始的每一行，如果它是买入或卖出

我尝试了许多更改但同样的问题。我确定它正盯着我看，但我看不到我的错误。任何人都可以建议更正吗？顺便说一句，它不是最漂亮的代码，所以如果你有更好的解决方案，我会全力以赴。谢谢

Sub changeformat()


Dim p As Integer
Dim r As Integer
Dim c As Integer




p = 150
For r = 1 To 140
c = 4
Range("A" & r).Select

    Do While ActiveCell.Value = """"
         Do Until c = 303
                Cells(r, c).Select
                If InStr(ActiveCell.Value, "Buy") > 0 Or InStr(ActiveCell.Value,"Buy")  > 0 Then

                'The first 3 cells will of each new row will be the same as the first 3 cells
                'of current active 'original' row

                ActiveSheet.Cells(p, 1).Value = ActiveSheet.Cells(r, 1).Value
                ActiveSheet.Cells(p, 2).Value = ActiveSheet.Cells(r, 2).Value
                ActiveSheet.Cells(p, 3).Value = ActiveSheet.Cells(r, 3).Value

                'The active cell and the 2 cells that follow will be pasted to
                'columns D to F in row p

                ActiveSheet.Cells(p, 4).Value = ActiveSheet.Cells(r, c).Value
                ActiveSheet.Cells(p, 5).Value = ActiveSheet.Cells(r, c + 1).Value
                ActiveSheet.Cells(p, 6).Value = ActiveSheet.Cells(r, c + 2).Value


                p = p + 1
                c = c + 3
                End If

        Loop
    Loop
Next r





End Sub

编辑

我做了以下更改，无限循环似乎已经停止。它现在几乎完成了它应该做的事情，但它正在省略数据。例如，我工作表上的第一行只有 9 个单元格（2 个帐户）。第二个有 33 个（10 个帐户）。这 2 行应转换为 12 个帐户的 12 个新行。不幸的是，它只是复制每行中的第一个帐户。它对前 11 行执行此操作，然后对第 12 行和第 13 行执行此操作。对可能发生的情况有什么建议吗？谢谢

p = 150
For r = 1 To 140

If Range("A" & r).Value <> "" Then

    'Do While Range("A" & r) <> """"
         For c = 4 To 303
                Cells(r, c).Select
                If ActiveCell.Value <> "" Then
                If InStr(ActiveCell.Value, "Buy") > 0 Or InStr(ActiveCell.Value, "Buy") > 0 Then

                'The first 3 cells will of each new row will be the same as the first 3 cells
                'of current active 'original' row

                ActiveSheet.Cells(p, 1).Value = ActiveSheet.Cells(r, 1).Value
                ActiveSheet.Cells(p, 2).Value = ActiveSheet.Cells(r, 2).Value
                ActiveSheet.Cells(p, 3).Value = ActiveSheet.Cells(r, 3).Value

                'The active cell and the 2 cells that follow will be pasted to
                'columns D to F in row p

                ActiveSheet.Cells(p, 4).Value = ActiveSheet.Cells(r, c).Value
                ActiveSheet.Cells(p, 5).Value = ActiveSheet.Cells(r, c + 1).Value
                ActiveSheet.Cells(p, 6).Value = ActiveSheet.Cells(r, c + 2).Value


                p = p + 1

                End If
                End If

        Next c
    'Loop
    End If
Next r

Answer 1

尝试从此更改循环条件

Do While ActiveCell.Value = """"

对此

Do While ActiveCell.Value = "'' ''"

....或者向自己证明发生了什么打开一个空白工作簿并打开即时窗口 (Ctl+G) 并运行它ActiveCell.Value = """"并查看它在单元格中放置的内容 - 可能不是您想要的。

在VBA其中两个'字符串中实际上等于其中一个"

所以也许你的条件Do-Loop永远不会满足。

---

编辑

...在您的数据示例中，我看不到这一点""？

---

编辑2

我注意到一个IF看起来不像是必需的。你知道如何单步执行宏吗？这无疑是找到像这样的复杂循环问题的最佳方法。

1. 将光标放在宏的顶部，就在该行的下方Sub ...
2. 按F8
3. 第一行现在应该突出显示
   每次您现在按 F8 时都会执行一行代码，您将能够看到工作表上发生的情况，如果您将光标悬停在 IDE 中的任何变量上，它会告诉您你现在的价值是多少。
4. 做几个循环，问题可能对你来说很明显，因为你面前 的实际工作表。
5. 如果你想让它运行到最后按 F5 否则你可以中途停止它。

Dim p As Integer
Dim r As Integer
Dim c As Integer

p = 150
For r = 1 To 140

with Excel.Activesheet
If .Range("A" & r) <> "" Then '<<<<<<<.value is the defualt property so no need to include it in code

         For c = 4 To 303
                '.Cells(r, c).Select '<<<<best to aviod using select if you can
                'If .Cells(r, c).Value <> "" Then '<<<<<<<<MAYBE NOT NEEDED
                If InStr(.Cells(r, c), "Buy") > 0 Or InStr(.Cells(r, c), "Buy") > 0 Then  '<<<<<<<<<<<<<<<<<<< WHY ARE YOUR TWO CONDITIONS THE SAME?

                        'The first 3 cells will of each new row will be the same as the first 3 cells
                        'of current active 'original' row

                        .Cells(p, 1) = .Cells(r, 1)
                        .Cells(p, 2) = .Cells(r, 2)
                        .Cells(p, 3) = .Cells(r, 3)

                        'The active cell and the 2 cells that follow will be pasted to
                        'columns D to F in row p

                        .Cells(p, 4) = .Cells(r, c)
                        .Cells(p, 5) = .Cells(r, c + 1)
                        .Cells(p, 6) = .Cells(r, c + 2)

                        p = p + 1

                End If
                'End If
        Next c
    'Loop
    End If
Next r