Question

我是新手。尝试以下内容：我在行中配对数据，一个在另一个下面，我希望它与另一个相邻（因此，不是范围A2到FP2和A3到FP3，我希望它是A2到MF2）。所以，基本上，我需要将每隔一行附加到上一行。

我一直在尝试制作一个循环来复制它，然后将该行剪切到另一张纸上，以便条件保持不变（始终复制第2行旁边的第3行），但是我无法制作它复制到第二张新的免费行。我在调试期间遇到了各种问题（Fors，Ifs，Columns ......）

无论如何，这是当前的代码，虽然很糟糕，并且事先非常感谢！

Sub pairs()

Application.CutCopyMode = False
For Each cell In Sheets("Sve").Range("A2")
        Sheets("Sve").Select
        Range("A3:FQ3").Select
        Selection.Cut
        Range("FR2").Select
        ActiveSheet.Paste
        Rows("3:3").Select
        Selection.Delete Shift:=xlUp
        Rows("2:2").Select
        Selection.Cut
        Sheets("Gotovo").Select
        sourceCol = 1
        rowCount = Cells(Rows.Count, sourceCol).End(x1Up).Row
        For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Or currentRowValue = "" Then
                Cells(currentRow, sourceCol).Select
            End If
        Next
        ActiveSheet.Paste
        Sheets("Sve").Select
Next

End Sub

Answer 1

我发现，如果从底部开始并逐步完成数据，则在循环浏览数据时更容易删除行。

Dim myRange As Range
Dim rowCount As Integer

' Get the range of cells and the count of cells in the A Column
Set myRange = Range("A1", Range("A1").End(xlDown))
rowCount = myRange.Cells.Count

' Start loop at the last row and decrease by 2
For i = rowCount To 2 Step -2

    ' Get the data in the i-th row, inclusive of blank cells between data
    Set secondrow = Range(myRange.Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft))

    ' place i-th row at the end of the (i-1)th row, inclusive of any 
    ' blank cells b/t data
    secondrow.Copy Cells(i - 1, Columns.Count).End(xlToLeft).Offset(0, 1)

    ' Delete the second row
    myRange.Cells(i, 1).EntireRow.Delete
Next i

现在您有一张表格，其行的格式符合您的要求，您可以更新代码，将所有这些数据复制到另一张表格。

<强>已更新

此代码包含一种捕获具有空白数据的行的方法。由于一行数据可能包含空白单元格（例如AB（空白）D），我使用Columns.Count获取该行的最后一列，然后使用.End(XlToLeft)方法获取最后一列行的空白单元格。粘贴数据时，您只需将列数增加一（即Offset(0,1)），以便不复制行中数据的最后一个单元格。

在另一行值之后复制行值，然后将整行复制到另一个工作表

1 个答案: