请帮助阻止无限循环

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个账户）。这两行应转换为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的条件可能永远不会得到满足。

---

修改

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

---

<强> EDIT2

我注意到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