3

好的，所以我一直在努力解决这个问题，但我觉得答案应该非常简单！

首先，我编写了两个宏，我们称它们为 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

这两个都是自己工作的。现在，我要做的就是将它们循环在一起，所以如果满足某个条件，例如，如果左四列与右四列不匹配并且需要删除一行，那么这两个宏之一是叫。

现在，我为 Do While 循环编写了一个伪代码，但这是否接近我正在寻找的内容？主要问题是在工作表中的某些点，需要剪切和粘贴多达 20 行，所以我希望反复使用上面的宏，直到 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

我在正确的轨道上吗？我错过了一条线吗？

我感谢任何人可以提供的任何帮助。稍后我会以全新的心态回到这个问题，我会看看我自己是否也能找到解决方案！

谢谢！

编辑：样本数据集

xxx A01 A01 xxx

xxx A02 A04 xxx

xxx A06 A05 xxx

xxx A07 A06 xxx

xxx A08 A09 xxx

因此，如果右上角的 A01 是活动单元格，则当 ActiveCell=ActiveCell.Offset(0,-1) 时移动到下一行。此处，由于 Active Cell > 相邻单元格，因此执行 Leftcut。现在，Activecell < Adjacent cell，所以执行RightCut。另一个右切将使这两个单元格相等，因此光标将移动到下一行，然后再次移动。

4

1 回答 1

1

正如 Peter L. 所提到的，您至少应该增加i循环。

但是，我建议您更好地熟悉范围.Offset和.Resize范围。这将允许您显着减少代码。

我会为循环使用以下构造：

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

我没有测试它，因为我没有数据并且不了解目的，但我相信它会给你一个起点！

于 2013-02-18T20:55:32.900 回答