Вставка строки в алфавитном порядке с помощью нажатия кнопки в динамическом диапазоне и копирование формул и формата - PullRequest
0 голосов
/ 12 февраля 2019

Я работаю с Excel 2016 VBA.

Я хотел бы добиться следующего результата: Нажатие кнопки открывает форму, пользователь вводит имя в поле ввода и нажимает кнопку добавления (этот код мне удалось сделать, и он отлично работает).

В чем мне нужна помощь: после нажатия кнопки добавления на листе 1 в таблице 1 мне нужно вставить новую строку в алфавитном порядке на основе имени, введенного пользователем.Затем это имя должно идти в первом столбце таблицы, а для остальной таблицы формулы и форматы должны быть скопированы из строки выше (если новый ввод не займет самое первое место в таблице, вв каком случае его нужно будет скопировать снизу).Мне нужно повторить это примерно для 10 листов, каждый из которых имеет таблицу.

Пост Как вставить новую строку в диапазон и скопировать формулы Я думаю, что первый шаг к тому, что мне нужно, но, поскольку я новичок, я не понимаю, насколькопервого принятого ответа (по марже) и сколько измененного принятого второго варианта второго ответа (Том).Поскольку я новичок, у меня недостаточно очков репутации, чтобы комментировать пост и задавать вопрос напрямую.

Я также не уверен, куда в этом коде добавить часть о вставленном имени в первом столбце и действительно ли этот код соответствует алфавитному виду.

Заранее благодарю за помощь!

Оригинальный код от поля в сообщении:

Private Sub newRow(Optional line As Integer = -1)
Dim target As Range
Dim cell As Range
Dim rowNr As Integer

Set target = Range("A2:D3")

If line <> -1 Then
    rowNr = line
Else
    rowNr = target.Rows.Count
End If

target.Rows(rowNr + 1).Insert
target.Rows(rowNr).Copy target.Rows(rowNr + 1)
For Each cell In target.Rows(rowNr + 1).Cells
    If Left(cell.Formula, 1) <> "=" Then cell.Clear
Next cell
End Sub

Модифицированная версия, предложенная Томом в сообщении:

Private Sub InsertNewRowInRange(_
          TargetRange As Range, _
          Optional InsertAfterRowNumber As Integer = -1, _
          Optional InsertEntireSheetRow As Boolean = True)

' -- InsertAfterRowNumber must be 1 to TargetRange.Rows.Count - 1 for TargetRange to be extended by one Row and for there to be
' --    Formats and Formulas to copy from (e.g. can't be 0).  Default: If -1, defaults to TargetRange.Rows.Count.
' --    Recommend dummy spacer Row at the bottom of TargetRange which, btw, would also be necessary to manually extend a Range
' --    by one Row implicitly via Insert Row (vs. explicilty via changing Range definition).

    If InsertAfterRowNumber = -1 Then
        InsertAfterRowNumber = TargetRange.Rows.Count
    End If

    If InsertEntireSheetRow Then
        TargetRange.Cells(InsertAfterRowNumber + 1, 1).Select
        Selection.EntireRow.Insert
    Else
        TargetRange.Rows(InsertAfterRowNumber + 1).Insert
    End If

    TargetRange.Rows(InsertAfterRowNumber).Select
    Selection.Copy

    TargetRange.Rows(InsertAfterRowNumber + 1).Select
    Selection.PasteSpecial _
        Paste:=xlPasteFormats, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
    Selection.PasteSpecial _
        Paste:=xlPasteFormulas, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False

    Application.CutCopyMode = False

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...