Question

尝试运行下面的代码时遇到调试错误（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

Answer 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

做错误，自动填充代码

1 个答案: