Do While Error，自动填充代码

Posted 2023-02-24

【中文标题】Do While Error，自动填充代码

【英文标题】：Do While Error, Autofill code

【发布时间】：2018-04-19 17:37:29

【问题描述】：

我在尝试运行以下代码时遇到调试错误 (Do While)。 此代码的目的是查看一个列表（sheet5 中的 A 列）并在 sheet2 的 A 列中添加和/或替换。如果需要添加新的，也插入一整行。 另一件事是，我想自动填充 B2:G2 中的公式，直到 A 列内容的最后一行。

Sub AddNewPO()
    Dim Sheet5 As Worksheet
    Dim Sheet2 As Worksheet

    Set Sheet5 = ThisWorkbook.Sheets("New_POs")
    Set Sheet2 = ThisWorkbook.Sheets("Summary by PO")

    LastRow5 = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
    Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row

    i = 1
    Do While Sheet5.Cells(i, 1).Value = Sheet2.Cells(i, 1).Value
         i = i + 1
    Loop

    For j = i To LastRow5
        Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
        Sheet2.Rows(Lastrow2 + 2).EntireRow.Insert
        Sheet2.Range("A" & Lastrow2 + 1).Value = Sheet5.Range("A" & j).Value
    Next j

    Sheet5.Activate
End Sub

【问题讨论】：

错误出现在哪一行？

在做的时候.....

【参考方案1】：

你有一个无限的Do 循环，所以添加另一个退出条件，比如

If i > LastRow5 Or i > Lastrow2 Then Exit Do

要复制公式，请使用：

 Sheet2.Range("B2:G2").Copy  'Copy formulas
 Sheet2.Range("B3:G" & Lastrow2).PasteSpecial xlPasteFormulas

---

.

Option Explicit

Public Sub AddNewPO()
    Dim Sheet5 As Worksheet, LastRow5 As Long, i As Long
    Dim Sheet2 As Worksheet, Lastrow2 As Long, j As Long

    Set Sheet5 = ThisWorkbook.Sheets("New_POs")
    Set Sheet2 = ThisWorkbook.Sheets("Summary by PO")
    LastRow5 = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
    Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row

    i = 1
    Do While Sheet5.Cells(i, 1).Value = Sheet2.Cells(i, 1).Value
         i = i + 1
         If i > LastRow5 Or i > Lastrow2 Then Exit Do
    Loop

    Application.ScreenUpdating = False
    For j = i To LastRow5
        Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
        Sheet2.Rows(Lastrow2 + 2).EntireRow.Insert
        Sheet2.Range("A" & Lastrow2 + 1).Value = Sheet5.Range("A" & j).Value
    Next j
    Sheet2.Range("B2:G2").Copy  'Copy formulas
    Sheet2.Range("B3:G" & Lastrow2).PasteSpecial xlPasteFormulas
    Sheet5.Activate
    Application.ScreenUpdating = True
 End Sub

【讨论】：

这行得通！谢谢。现在如何将 B2 中的公式复制到 G2 中？

不。在 sheet2 上，在前面的代码完成后，我想将公式从 B2:G2 复制到 columnA 的 Lastrow2

最后一个问题，我在同一个 excel 中有 4 个不同的代码，我为每个代码使用一个按钮，但它们是连续的。我怎样才能将它们与一个按钮结合起来/

您可以再创建一个 Sub（假设是 Sub 5），然后从这个新的 sub 中调用所有其他 4 个 sub，这样您可以将 Sub5 分配给一个按钮并执行所有 4 个

一个很短（只是为了排序），另一个在寻找唯一值（就像我们做的那样），还有一个是我们做的