Добавление пользователей (и строк) в несколько листов с помощью пользовательской формы - PullRequest
0 голосов
/ 11 сентября 2018

Я надеялся, что смогу решить эту проблему сам, после того как мне предоставили решение моей предыдущей проблемы удаления строк, но я понял, что это не так просто, как я думал.

У меня естьнесколько рабочих листов в рабочей книге, которые используются для сбора различных данных о студентах.

Каждый рабочий лист начинается с имен учеников и подробностей о них - они копируются из рабочего листа «основных данных» - и различных данных.вводится в последующие столбцы на каждом рабочем листе.

У меня есть пользовательская форма для добавления и удаления студентов из всех рабочих листов.

У меня есть код, который я изменил из 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 голосов
/ 12 сентября 2018

Итак, глядя на ваш цикл 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
0 голосов
/ 11 сентября 2018

Как убедиться, что код добавляет новую строку к каждому рабочему листу, прежде чем выполнять шаги 2 и 3 на основном листе, а затем шаг 4 на каждом рабочем листе?

Ну, просто поместите каждый шаг в отдельный цикл.

For Each Sh In ThisWorkbook.Worksheets

    'code for e.g. step 1'

Next Sh

И расставьте все по порядку.

Кроме того, забегая вперед, я планирую добавить в рабочую книгу дополнительные листы, которые будут по-разному отформатированы и которые будут анализировать данные и представлять различные аспекты данных в таблицах и шаблонах для печати. Можно ли написать код, чтобы эти листы не были затронуты?

Вы можете исключить некоторые таблицы с помощью оператора If

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

Или наоборот:

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name = "Sheet2" Or Sh.Name = "Sheet3" Then
        'code'
    End If
Next Sh
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...