Question

我在创建一个修改系统生成报告的宏时遇到了一些问题。

我希望能够将我的系统生成的报告粘贴到excel中，并通过按下按钮（宏）它将选择我的数据的每隔一行并将数字复制到另一个标签，然后我希望它删除这些备用行。

然后它会转到另一个标签并抬起这些数字并将它们粘贴到外面的列中。

我试过通过录制宏来做到这一点，但我不知道如何让它来选择不同的数据范围。

任何人都可以提供的帮助将不胜感激。

保

Answer 1

以下代码应符合您的需求。它会检查您范围中的第一行是奇数还是偶数，它确定它移动到哪一列（“系列”中的第一行，其中包含值，移动到第一列，第二行，总计，移动）到第二栏）。

如果有帮助，请告诉我。

Sub MoveAlternatingToNewTab()
    Dim wsOrigin As Worksheet
    Dim wsDestination As Worksheet
    Dim rngOrigin As Range
    Dim isFIRST_ROW_ODD As Integer
    Dim cel As Range
    Dim nLastRow As Long

    Set wsOrigin = Worksheets("Sheet1")
    Set wsDestination = Worksheets("Sheet2")

    Set rngOrigin = wsOrigin.Range("A1:A12") 'Change this to suit your needs

    'Below variable stores whether the first row of the rngOrigin variable
    'Is odd or even. Used to know which column the data should be move to
    isFIRST_ROW_ODD = rngOrigin.Rows(1).Row Mod 2

    For Each cel In rngOrigin

        If cel.Row Mod 2 = isFIRST_ROW_ODD Then
        nLastRow = wsDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsDestination.Cells(nLastRow, 1) = cel.Value
        Else
            wsDestination.Cells(nLastRow, 2) = cel.Value
        End If
    Next cel
End Sub

Answer 2

[注意]要回答有关删除备用行的注释中的后续问题：

要删除交替的行，我更喜欢从数据集的底部开始向上工作。这样做可以防止工作表中的变化（由于删除）影响循环。首先，找到要删除的最后一行，然后向后循环，逐步增加2。

Sub DeleteAlternateRows()
    Dim nLastRow As Long

    nLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

    If nLastRow Mod 2 = 0 Then
        nLastRow = nLastRow - 1
    End If

    For i = nLastRow To 1 Step -2
        Worksheets("Sheet1").Rows(i).Delete
    Next i
End Sub

VBA - 系统生成的报告修订

2 个答案: