excel - 如何遍历工作表以添加带有公式和格式的新行

Question

我有一系列受保护的工作表，用于收集学生评估数据。这些被锁定以防止用户删除公式或导致其他问题，因此我需要能够使用用户表单将新记录添加到电子表格/数据库中。

我使用来自其他问题的建议和我（不断增长的）VBA 知识编译了以下代码，但是我的知识仍然很初级！

当我尝试运行代码时，我在该.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Select行收到“需要对象”错误，如图所示。我以为我已经定义并指示对象Sh使用With Sh线 - 不是这样吗？

我在代码中包含了注释，试图解释我想要实现的目标。任何人都可以阐明我在这里做错了什么吗？

Private Sub cmbAdd_Click()
Dim Sh As Variant
Dim l As Long

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
'ActiveSheet.Unprotect Password:="L1lyL1ly"


    ' IF THERE ARE MORE THAN 103 RECORDS, ADD A NEW ROW AND COPY FORMAT AND FORMULAE

    For Each Sh In Array("Pupil Data", "RWM", "Art", "Computing", "Design Technology", "Geography", "History_", "MFL", "Music", "PE", "RE", "Science", "Bookbands", "KS1 - TRP")

    ' Use the current worksheet
    With Sh

    ' !!!!!!!!!!!! THE ERROR OCCURS ON THE NEXT LINE !!!!!!!!!!!!!!!!

        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Select    ' Find the last used row in the table
        If .Cells(.Rows.Count) < 103 Then GoTo Add_Record            ' If the row number is less than 103 go to the Add_Record section otherwise add a new row and copy all formats and formulae

        .Rows(Selection.Row).Insert Shift:=xlDown

        With .Cells(.Rows.Count, "A").End(xlUp)
            .EntireRow.Copy
            With .Offset(1, 0).EntireRow
                .PasteSpecial xlPasteFormats
                .PasteSpecial xlPasteFormulas
                On Error Resume Next
                .SpecialCells(xlCellTypeConstants).ClearContents
                On Error GoTo 0
            End With
        End With
    End With
Next Sh     ' Cycle through to the next worksheet in the array and repeat the 'add line' procedure

Add_Record:   ' COPY NEW CHILD FROM FORM TO SPREADSHEET

Dim LR As Long
    LR = Sheets("Pupil Data").Range("A" & Rows.Count).End(xlUp).Row

    Set c = Range("A" & LR + 1)

    With Me
        c.Value = .TextBox14.Value
        c.Offset(0, 1).Value = .TextBox1.Value
        c.Offset(0, 2).Value = .TextBox2.Value
        c.Offset(0, 3).Value = .TextBox3.Value
        c.Offset(0, 4).Value = .TextBox4.Value
        c.Offset(0, 5).Value = .TextBox24.Value
        c.Offset(0, 7).Value = .TextBox25.Value
        c.Offset(0, 8).Value = .TextBox26.Value
        c.Offset(0, 9).Value = .TextBox5.Value
        c.Offset(0, 11).Value = .TextBox27.Value
        c.Offset(0, 12).Value = .TextBox28.Value
        c.Offset(0, 13).Value = .TextBox29.Value
        c.Offset(0, 14).Value = .TextBox30.Value
        c.Offset(0, 15).Value = .TextBox34.Value
        c.Offset(0, 16).Value = .TextBox31.Value
        c.Offset(0, 17).Value = .TextBox32.Value
        c.Offset(0, 18).Value = .TextBox33.Value
        c.Offset(0, 21).Value = .TextBox35.Value
        Call ClearControls
    End With

' FILL EMPTY CHARACTERISTICS CELLS

Dim rCell   As Range, _
        rRng    As Range

    For Each rRng In ActiveSheet.[A4].Resize(ActiveSheet.UsedRange.Rows.Count - 2)
        If IsEmpty(rRng) Then GoTo NextRow
        For Each rCell In rRng.Offset(0, 7).Resize(1, 17)
            If IsEmpty(rCell) Then rCell.Value = "N"
        Next rCell
NextRow:
    Next rRng

' SORT DATA TO INCLUDE NEW CHILD

 Call ResortData

Application.ScreenUpdating = True
'ActiveSheet.Protect "L1lyL1ly", _                      'Remove the ' from the start of the line when password protected
    'AllowFiltering:=True, _
    'AllowSorting:=True, _
    'AllowFormattingColumns:=True, _
    'AllowFormattingRows:=True

End Sub

标签： excelvbainsertrowuserform

Answer 1

正如 StoneGiant 评论的那样，您实际上并没有遍历工作表，您还选择了最后一行，而没有先选择工作表，这会给您一个错误，我也建议不要使用嵌套的 With 语句，它不仅可以获得令人困惑，它实际上可能无法按预期工作，我相信下面的修改代码将帮助您实现您想要的：

Private Sub cmbAdd_Click()
Dim Sh As Worksheet
Dim l As Long
Dim LastRow As Long
Dim LR As Long

Application.ScreenUpdating = False
    ' IF THERE ARE MORE THAN 103 RECORDS, ADD A NEW ROW AND COPY FORMAT AND FORMULAE

    For Each Sh In ThisWorkbook.Worksheets
        ' Use the current worksheet
        With Sh
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)    ' Find the last used row in the table
            If LastRow < 103 Then GoTo Add_Record            ' If the row number is less than 103 go to the Add_Record section otherwise add a new row and copy all formats and formulae
            .Rows(LastRow).Insert Shift:=xlDown
            .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Copy
            .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Offset(1, 0).EntireRow.PasteSpecial xlPasteFormats
            .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Offset(1, 0).EntireRow.ClearContents
            .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Offset(1, 0).EntireRow.PasteSpecial xlPasteFormulas
        End With
    Next Sh     ' Cycle through to the next worksheet in the array and repeat the 'add line' procedure

Add_Record:       ' COPY NEW CHILD FROM FORM TO SPREADSHEET

    LR = Sheets("Pupil Data").Range("A" & Rows.Count).End(xlUp).Row

    Set c = Range("A" & LR + 1)

    With Me
        c.Value = .TextBox14.Value
        c.Offset(0, 1).Value = .TextBox1.Value
        c.Offset(0, 2).Value = .TextBox2.Value
        c.Offset(0, 3).Value = .TextBox3.Value
        c.Offset(0, 4).Value = .TextBox4.Value
        c.Offset(0, 5).Value = .TextBox24.Value
        c.Offset(0, 7).Value = .TextBox25.Value
        c.Offset(0, 8).Value = .TextBox26.Value
        c.Offset(0, 9).Value = .TextBox5.Value
        c.Offset(0, 11).Value = .TextBox27.Value
        c.Offset(0, 12).Value = .TextBox28.Value
        c.Offset(0, 13).Value = .TextBox29.Value
        c.Offset(0, 14).Value = .TextBox30.Value
        c.Offset(0, 15).Value = .TextBox34.Value
        c.Offset(0, 16).Value = .TextBox31.Value
        c.Offset(0, 17).Value = .TextBox32.Value
        c.Offset(0, 18).Value = .TextBox33.Value
        c.Offset(0, 21).Value = .TextBox35.Value
        Call ClearControls
    End With

' FILL EMPTY CHARACTERISTICS CELLS

Dim rCell As Range, rRng As Range

    For Each rRng In ActiveSheet.[A4].Resize(ActiveSheet.UsedRange.Rows.Count - 2)
        If IsEmpty(rRng) Then GoTo NextRow
        For Each rCell In rRng.Offset(0, 7).Resize(1, 17)
            If IsEmpty(rCell) Then rCell.Value = "N"
        Next rCell
NextRow:
    Next rRng

' SORT DATA TO INCLUDE NEW CHILD

 Call ResortData

Application.ScreenUpdating = True
End Sub