VBA - 使用公式复制 6 行并在每次更改值后插入答案

【问题标题】：VBA - Copy 6 Rows with Formulas and Insert after each change in valueVBA - 使用公式复制 6 行并在每次更改值后插入
【发布时间】：2014-11-27 15:11:49
【问题描述】：

论坛新手，没有 VBA 经验。

我对术语不是很熟悉，所以如果我在这里使用了一些不正确的语言，请原谅我......我昨天开始搜索 VBA 代码时有一些运气，但没有我真正需要的，所以我希望有人在那里可以教育我。我想运行一个宏，它会自动从我的模板表中复制 6 行带有公式和条件格式的连续行，然后在每次更改值后，特别是在每次更改日期后，将它们与所有公式和格式完整地插入。截至目前，我可以使用以下代码过滤空白并手动粘贴单元格，但这并不比仅复制和插入没有代码的行好多少。任何帮助将不胜感激，如果需要，我可以发布表格。提前致谢！

Sub InsertRowAtChangeInValue()

    Dim lRow As Long

    For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
        If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
        End If
    Next lRow
End Sub

【问题讨论】：

值（“日期”）究竟如何变化？仅供参考 - 开始熟悉 VBA 的一个好方法是记录宏并查看为您生成的代码。它不会很漂亮，也不会使用最佳实践，但可以让您快速了解 VBA 的工作原理。更好的办法是在录制时打开工作表旁边的模块，这样您就可以在对工作表进行更改时看到代码出现。
我会试试的，谢谢...基本上，我有数百行显示按日期排序的时间表，有时 20 个作业（20 个连续行）的数据将具有相同的日期，所以每次约会后，我都有每种工作类型的总数和其他公式，这些公式可以为我提供所需的每日数字。
张贴您的工作表，并在可能的情况下明确说明您的要求。
我明天可以发布表格，但这是我目前所拥有的。如果有办法在使用此代码插入时保持条件格式，那就太好了。 Sub InsertRowAtChangeInValue() Dim lRow As Long For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1 If Cells(lRow, "B") Cells(lRow - 1、"B") Then Sheets("Template").Select Rows("2:7").Select Selection.Copy Sheets("Current").Select Rows(lRow).EntireRow.Insert End If Next lRow End Sub

标签： vba excel

【解决方案1】：

我不知道如何删除它，但我能够使用以下方法让一切正常工作：

Sub InsertRowAtChangeInValue()

    Sheets("dfw production schedule").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Current").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A2").Select

Dim lRow As Long

For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then
        Sheets("Template").Select
        Rows("2:7").Select
        Selection.Copy
           Sheets("Current").Select
           Rows(lRow).EntireRow.Insert
    End If
Next lRow

结束子

【讨论】：