Question

我尝试使用Offset来复制和粘贴以及大约一百万个其他内容。这曾经有大约十个ElseIf，我注释了试图简化以帮助我弄清楚。我能想到的唯一另一件事就是我脑子里有抽筋，所以任何帮助都会受到赞赏！

Sub areax()

    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
    Dim Lr As Long

    For Lr = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 6 Step -1
        If Cells(Lr, "B") <> 0 Then

       If Cells(Lr, "B") = 6 Then
            Set Rng1 = Range("E" & ActiveCell.Row & ":I" & ActiveCell.Row)
            Set Rng2 = Range("E" & Rows.Count).End(xlUp).Offset(1)
            Rng1.COPY Rng2
            Application.CutCopyMode = False

        Else
            If Cells(Lr, "B") = 12 Then
                Set Rng1 = Range("E" & ActiveCell.Row & ":J" & ActiveCell.Row)
                Set Rng2 = Range("K" & ActiveCell.Row & ":P" & ActiveCell.Row)
                Set Rng4 = Range("E" & Rows.Count).End(xlUp).Offset(1)
                Rng1.COPY Rng4
                Rng2.COPY Rng4
                Application.CutCopyMode = False
            End If
        End If
        End If
    Next Lr

End Sub

Answer 1

好的山姆斧 - 今晚必须退出，但请尝试下面的代码。

从我上次查询评论到你，它假设col B与原始数据网格（9）具有相同的行数，并且我们仅在重建网格中使用E：J和K：P列。如果不是这种情况，那么你可以制作一些合适的mod。

同样适用以下假设，再次根据您的具体情况进行修改：

假设网格数据与col B在同一张纸上

假设此表格被称为“数据”

假设重建的网格数据从原始数据网格开始col

开始

我已经使用了一些变量，以便您可以灵活地轻松更改输出/布局等。我还在代码中进行了两次“替换”。 1.替换IF THEN构造与SELECT CASE构造，这将允许您添加其他条件和2.替换您的测试col B值大于0，并测试它是一个数值。如果字符串意外地进入，它不会崩溃。

@Steffen Sylvest Neilson慷慨地承认了Dim的评论，并为您提供了一个可能探索的链接。

由于我缺乏理解，可能还不能完美满足您的需求，但如前所述，对您来说应该是一个很好的启动。

PS解释为什么你似乎没有复制任何东西可能是因为可能在你的数据之外选择了ActiveCell。 ActiveCell不跟随你的循环计数器。

Sub areax()

Dim Rng1 As Range, Rng2 As Range
Dim lBrow As Long, lGridRow As Long, c As Long

Dim sdRow As Long, sdCol As Long
Dim gridsRow As Long, gridsCol As Long

'data start r/c
sdRow = 6
sdCol = 2

'grid start r/c
gridsRow = 6
gridsCol = 5

    With Sheets("Data")

    lBrow = .Cells(Rows.Count, sdCol).End(xlUp).Row

        'for each row in col B
        For c = sdRow To lBrow
            If IsNumeric(.Cells(c, "B")) Then
                'set next available row at bottom of grid
                lGridRow = .Cells(Rows.Count, gridsCol).End(xlUp).Row + 1
                    'test col B cell value
                    Select Case .Cells(c, sdCol)
                        Case Is = 6
                            Set Rng1 = .Range(.Cells(c, "E"), .Cells(c, "J"))
                            Rng1.Copy Destination:=.Cells(lGridRow, gridsCol)
                            Application.CutCopyMode = False

                        Case Is = 12
                            Set Rng1 = .Range(.Cells(c, "E"), .Cells(c, "J"))
                            Set Rng2 = .Range(.Cells(c, "K"), .Cells(c, "P"))
                            Rng1.Copy Destination:=.Cells(lGridRow, gridsCol)
                            'add 1 to last grid row because of double-copy
                            lGridRow = lGridRow + 1
                            Rng2.Copy Destination:=.Cells(lGridRow, gridsCol)
                    End Select
            End If
        Next c

    Application.CutCopyMode = False

    End With

End Sub

循环范围。如果等于值，则复制。运行但没有结果

1 个答案: