Question

我有一份报告，列出了当月销售人员的销售情况。当销售类型为＆＃34;打开＆＃34;时，D列中的单元格将以O开头（打开订单，打开分层等）。我不能在每月销售额小计中包含未结订单，而是将打开订单放在销售额下方的单独部分中，这些部分名为＆＃34;打开订单＆＃34;。

所以我需要宏做的是每当D列中的单元格以O， cut 整行和 insert 开头时（需要插入所以他们的isn＆粘贴时粘贴空白）粘贴到数据下方。这将在我们插入之后移动数据。我遇到的问题是，即使我们已经遍历了数据集中的所有行，宏也将继续剪切和粘贴。

Sub MoveOPENS()

'this is what im using to establish the last row in the data set
  Cells(1, 1).Select
  Selection.End(xlDown).Select
  nRowMax = Selection.Row

For i = 2 To nRowMax
    sItem = Cells(i, 4)

    Do While Left(sItem, 1) = "O"
        Rows(i).Select
        Selection.Cut
    'moves the cursor to below the data set
        Selection.End(xlToLeft).Select
        Selection.End(xlDown).Select
        Selection.Offset(4, 0).Select
    'this part works well but it thinks the loop doesn't stop 
    'and will start copy and pasting below the new data section
    Selection.Insert
        sItem = Cells(i, 4)
    Loop
Next i

End Sub

如何让宏知道我们何时到达最后一行，以便它不会继续剪切并粘贴我们刚刚复制和粘贴的行？如果您需要更多详细信息，请与我们联系

Here is what the excel sheet looks like

Answer 1

由于你切割了行，你的nRowMax变得毫无意义。比方说，你有1000行，但是你切了100行，所以最终你会有900行，但你仍然试图在第901行和第1000行之间循环。

作为一个解决方案，您可以将循环创建为do循环而不是for循环，如下所示。

Sub MoveOPENS()

    Dim sItem As String

    Cells(2, 1).Select
    r = 1
    Do
        sItem = ActiveCell.Offset(0, 3).Value

        If Left(sItem, 1) = "O" Then
            r = ActiveCell.Row
            ActiveCell.EntireRow.Select
            Selection.Cut
            'moves the cursor to below the data set
            Cells(1000000, 1).End(xlUp).Offset(1, 0).Select
            Selection.Insert
            Cells(r, 1).Select
        Else
            ActiveCell.Offset(1, 0).Select
        End If

Loop Until IsEmpty(ActiveCell)

End Sub

Answer 2

怎么样：

Sub MoveOPENS()

    Dim lRowMax As Long
    Dim sItem As String


'this is what im using to establish the last row in the data set
    Cells(1, 1).Select
    Selection.End(xlDown).Select
    lRowMax = Selection.Row

    For i = 2 To lRowMax
        sItem = Cells(i, 4).Value

        If Left(sItem, 1) = "O" Then
            Rows(i).Select
            Selection.Cut
            'moves the cursor to below the data set
            Selection.End(xlToLeft).Select
            Selection.End(xlDown).Select
            Selection.Offset(4, 0).Select
            'this part works well but it thinks the loop doesn't stop
            'and will start copy and pasting below the new data section
            Selection.Insert
        End If
    Next i

End Sub

Answer 3

我希望你不介意我从头开始重新编写代码。看起来你可能已经录制了一个宏来执行此操作，这是一个很好的起点，当你不确定如何处理它时，但它有时会产生一些非常低效和令人困惑的代码。

无论如何，这应该适合你：

Sub MoveOPENS()

Dim LastRow, NewLast, MovedCount As Integer

LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 'Find last Row
NewLast = LastRow + 1 'NewLast tracks the new last row as rows are copied and pasted at the end
MovedCount = 0
    For i = 2 To LastRow
        If Left(Cells(i, 4), 1) = "O" Then    'Copy the row, increment NewLast and paste at the bottom.
            Rows(i).Cut
            'LastRow = LastRow - 1
            Cells(NewLast, 1).Select
            ActiveSheet.Paste
            Rows(i).Delete
            i = i - 1  'Since we deleted the row, we must decrement i
            MovedCount = MovedCount + 1  'Keeps track of number of rows moved so as not to overshoot the original last line

        End If
        If i + MovedCount = LastRow Then Exit For 'Exit For loop if we reached the original last line of the file
    Next i
End Sub

宏在数据循环下方剪切并粘贴整行

3 个答案: