在Excel中寻找循环两个VBAmacros，但我想我只是错过了一些非常小的东西

好的，所以我一直拉着我的头发试图弄清楚，但是我觉得好像答案应该是非常简单的！

首先，我写了两个macros，我们称之为LeftCut和RightCut。 这些将切出一行四列，并粘贴在表格中的其他地方。 这些VBA代码是

Sub RightCut() ActiveCell.Offset([0], [-1]).Select Range(ActiveCell, ActiveCell.Offset(0, -3)).Cut ActiveCell.Offset([0], [6]).Select Range(ActiveCell, ActiveCell.Offset(0, 3)).Select Selection.Insert Shift:=xlDown ActiveCell.Offset([0], [-6]).Select Range(ActiveCell, ActiveCell.Offset(0, -3)).Select Selection.Delete Shift:=xlUp End Sub Sub LeftCut Range(ActiveCell, ActiveCell.Offset(0, 3)).Cut ActiveCell.Offset([0], [10]).Select Range(ActiveCell, ActiveCell.Offset(0, 3)).Select Selection.Insert Shift:=xlDown ActiveCell.Offset([0], [-10]).Select Range(ActiveCell, ActiveCell.Offset(0, 3)).Select Selection.Delete Shift:=xlUp End Sub 

这两个工作是自己的。 现在我所要做的就是把这些循环结合在一起，如果满足一定的条件，比如说如果左边的四列不匹配四个右边的列，需要删除一行，那么这两个macros中的一个是调用。

现在，我有一个为Do While循环编写的伪代码，但是这甚至接近我所寻找的？ 主要的问题是，在工作表中的某些点，需要剪切和粘贴多达20行，所以我希望上面的macros反复使用，直到ActiveCell = ActiveCell.Offset（0，-1） 。 这可能与一个Do While循环？

 Sub HighAce() Dim i As Long Dim ActiveCell As Range i = 2 Application.ScreenUpdating = True Do While i <= 40043 Set ActiveCell = Range("E" & i) If ActiveCell = ActiveCell.Offset([0], [-1]) Then ActiveCell.Offset([1], [0]).Select ElseIf ActiveCell > ActiveCell.Offset([0], [-1]) Then Application.Run "'Methylation Array.xlsm'!NewBlueCut" ElseIf ActiveCell < ActiveCell.Offset([0], [-1]) Then Application.Run "'Methylation Array.xlsm'!NewBlueCut" Else: Stop End If Loop End Sub 

我在这里的正确轨道？ 有没有我失踪的线？

我感谢任何人都可以提供帮助。 我以后会再次回头讨论这个问题，我会看看我是否也可以自己find一个解决scheme！

谢谢！

编辑：示例数据集

xxx A01 A01 xxx

xxx A02 A04 xxx

xxx A06 A05 xxx

xxx A07 A06 xxx

xxx A08 A09 xxx

所以如果右上angular的A01是活动单元格，当ActiveCell = ActiveCell.Offset（0，-1），然后移动到下一行。 在此，由于活动单元>相邻单元，执行Leftcut。 现在，Activecell <Adjacent cell，那么执行RightCut。 另一个右切将使这两个单元格相等，所以光标将移动到下一行，然后再次移动。

Answer 1

正如Peter L.所说，你至less应该增加你的循环。

不过，我build议你最好熟悉一下.Offset和.Resize范围。 这将允许你显着减less你的代码。

我会使用以下结构的循环：

 Set rng = Range("E2") While _condition_ ...Do something Set rng = rng.offset(1) Wend 

我最终得到了这个最终的代码，也修改了你的剪切下标：

 Sub RightCut(rng As Range) rng.Offset(, -4).Resize(, 4).Cut rng.Offset(, 5).Resize(, 4).Insert xlDown rng.Offset(, -4).Resize(, 4).Delete xlUp End Sub Sub LeftCut(rng As Range) rng.Resize(, 4).Cut rng.Offset(, 10).Resize(, 4).Insert xlDown rng.Resize(, 4).Delete xlUp End Sub Sub HighAce() Dim rng As Range Dim lngcount as Long Application.ScreenUpdating = True Set rng = Range("E2") While rng <> "" And rng <> rng.Offset(, -1) lngCount = lngCount + 1 If lngCount > 40000 Then Stop If rng > rng.Offset(, -1) Then LeftCut rng ElseIf rng < rng.Offset(, -1) Then RightCut rng Else lngCount = 1 Set rng = rng.Offset(1) End If 'This assign the next row Wend End Sub 

我没有testing，因为我没有数据，也不明白目的，但我相信它会给你一个出发点！