使用用户表单将用户(和行)添加到多个工作表中

时间:2018-09-11 14:32:06

标签: excel vba rows

在为我之前删除行的问题提供了解决方案之后,我希望自己能够解决此问题,但是我意识到它并不像我想的那么简单。

我的工作簿中有许多工作表,用于收集学生的各种数据。

每个工作表均以学生姓名和有关学生的详细信息开头-这些是从“主数据”工作表中复制的-各种数据将输入到每个工作表的后续列中。

我有一个用户表单,可以从所有工作表中添加和删除学生。

我有从Roy Cox修改而来的代码,该代码在主数据列表的底部添加了一个学生,然后对数据进行排序,以便将学生包括在正确的班级中,并按正确的字母顺序排列。

编辑11/09-16:34-为清楚起见,复制了整个代码。

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

Application.ScreenUpdating = False

' 1) ADD NEW ROW TO EACH WORKSHEET, COPYING FORMAT AND FORMULAE

For Each Sh In ThisWorkbook.Worksheets
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    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
Next Sh

' 2) COPY NEW CHILD FROM USERFORM TO MASTER DATA WORKSHEET

Dim LR As Long
    LR = Sheets("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 = .TextBox31.Value
    c.Offset(0, 16).Value = .TextBox32.Value
    c.Offset(0, 17).Value = .TextBox33.Value
    Call ClearControls
End With

' 3) FILL EMPTY CHARACTERISTICS CELLS ON MASTER DATA WORKSHEET

Dim rCell   As Range
Dim rRng    As Range

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

' 4) SORT DATA TO INCLUDE NEW CHILD ON EACH WORKSHEET

 Call ResortData

Application.ScreenUpdating = True

End Sub

ResortData子项也在下面添加:

Sub ResortData()

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

Application.ScreenUpdating = False

For Each Sh In ThisWorkbook.Worksheets

Range("A4:BE" & LastRow).Sort Key1:=Range("C4:C" & LastRow), Order1:=xlAscending, Header:=xlNo, _
Key2:=Range("B4:B" & LastRow), Order1:=xlAscending, Header:=xlNo ' CHANGE 'BE' TO LAST COLUMN OF SPREADSHEET

Next

Application.ScreenUpdating = True

End Sub

当前,“主数据”表已更新为新的瞳孔和其他3行(我的试用版工作簿中还有3个其他工作表,所以我认为是这样)。

在完成主表上的步骤2和3,然后在每个工作表上执行步骤4之前,如何确保代码在每个工作表上添加一行新内容?

(我需要在每个工作表上分别完成步骤4,因为从第V列开始,每个工作表上收集的数据和列标题都不同)

感谢您提供的任何建议。

2 个答案:

答案 0 :(得分:0)

  

在完成主表上的第2步和第3步以及每个工作表上的第4步之前,如何确保代码向每个工作表添加新行?

好吧,只需将每个步骤放入单独的循环中即可。

@echo off
setlocal enabledelayedexpansion
for %%i in (*.pdf) do (
for /f "tokens=1,2" %%a in ("%%i") do (
     set num=%%b
     set num=!num:%%~xb=!
     set num=!num:^(=!
     set num=!num:^)=!
     set /a num=!num!-1
     set "minname=%%a"
     set /a newname=minname+num
     echo ren "%%i" !newname!%%~xi
  )
 )

并按正确的顺序进行操作。

  

我还想着,我计划在工作簿中添加一些其他工作表,这些工作表的格式将有所不同,并将分析数据并在要打印的表和模板中显示数据的各个方面。可以编写代码使这些表不受影响吗?

您可以使用If语句排除某些工作表

For Each Sh In ThisWorkbook.Worksheets

    'code for e.g. step 1'

Next Sh

反之亦然:

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet2" And Sh.Name <> "Sheet3" Then
        'code'
    End If
Next Sh

答案 1 :(得分:0)

因此,查看您的For循环,您正在做的是:拾取工作簿中的每个工作表,然后引用活动工作表而不是要参考的工作表上的单元格。这是因为当您引用单元格/范围时,您没有明确说出要向其添加行的工作表。请尝试以下代码(我尚未测试代码):

Dim Sh As Worksheet

For Each Sh In ThisWorkbook.Worksheets
    ' Use the current worksheet
    With Sh

        ' Notice the dots(.) infront of Cells and Rows. This is now referencing the cells and rows in 'Sh' sheet
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        .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