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

我曾尝试使用偏移量来复制和粘贴加上大约一百万个其他东西。这本书曾经有大约十本其他的书，我对它们进行了评论，试图简化它们来帮助我理解。我唯一能想到的另一件事是，我在这件事上有一个大脑抽筋，所以任何帮助都将不胜感激

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

---

好的sam axe-今晚必须注销，但请尝试下面的代码

从我上次给您的查询注释来看，它假设B列的行数与原始数据网格9的行数相同，并且我们在重建的网格中只使用E:J和K:p列。如果不是这样，那么你可以做一些适当的MOD

此外，以下假设也适用，请再次修改以适应您的环境：

假设网格数据与B列在同一张表中

假设此工作表称为数据

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

我使用了更多的变量，这样您就可以灵活地轻松更改输出/布局等。我还在代码中做了两个“替换”。1.将IF THEN构造替换为SELECT CASE构造，该构造将允许您添加其他条件和2。将列B值大于0的测试替换为数值测试。如果一根绳子不小心爬了进来，它就不会崩溃

@Steffen Sylvest Neilson很有礼貌地承认了这一模糊的评论，并为您提供了一个链接，或许您可以进行探索

由于我缺乏理解，可能还不能完全满足您的需求，但如前所述，应该是您的良好开端

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

---

复制范围而不仅仅是值是否重要？你也需要格式化，或者重点是什么？另外，你不需要单独调暗所有变量，你可以调暗Rng1、Rng2、Rng3、Rng4作为范围。我只需要这些值，我不知道怎么做。谢谢你在DIM上的提示。你能用你的数据用语言解释你想做什么吗？我会给你一个开始。此外，在VBA中声明变量的方式也是正确的。如果您按照Steffen S N的建议声明它们，那么只有示例中的最后一个变量Rng4将被声明为Long。这一行上的其他变量将被声明为Variant。我有9行数据，跨越45列E6:aw14让我们调用这个范围x，范围x之外的x列B包含基于变量的索引和匹配结果到另一个工作表。这用于在x范围内构建网格。网格的宽度可以达到45列，每行的宽度由B列的值决定。我需要重建网格，使其宽度不超过6列。为了实现这一点，我检查B中单元格的值，如果=6，我可以将值复制并粘贴到下一个空单元格中，如果值为12，我必须复制并粘贴两部分到下一个空单元格中。我要到星期一才能检查，我应该把笔记本带回家！再次感谢！好了，开始工作了！但是，数据正在移动到Excel中的最后一行。Debug.Print.cellsgridrow，gridsCol返回1048576，所以我认为这就是问题所在。我看看能不能弄明白。我是这样做的：=SheetsData.range&Rows.Count.EndxlUp.Offset1我真是太感谢你了！如果你知道这最后一部分出了什么问题，我很想知道。你好，山姆·阿克斯。很高兴你让它工作了。我无法复制你报告的问题。检查第一个lGridRow=。。。循环中的行。我认为Case=6部分中的Application.CutCopyMode行也可以在不影响事情的情况下显示出来。也谢谢你把分数作为答案。