Question

我正在使用excel 2016 VBA。

我想获得以下结果：单击按钮可打开一个表单，用户在输入框中输入一个名称，然后单击添加按钮（此代码已成功完成，并且运行良好）。

我需要什么帮助：在表1的Sheet1上单击添加按钮后，我需要根据用户输入的名称按字母顺序插入新行。然后，该名称需要放在表的第一列中，而对于表的其余部分，则需要从上一行向下复制公式和格式（除非新输入在表中排在第一位，在这种情况下，则需要从下面进行复制）。然后，我需要重复大约10张纸，每张纸都有一张桌子。

帖子How to insert a new row into a range and copy formulas是我认为需要的第一步，但由于我是初学者，所以我不了解（marg）接受的第一个答案是多少，以及修改后接受了第二个答案的第二版（汤姆）。由于我是新手，所以我没有足够的声誉积分来评论该帖子并直接提出问题。

我也不确定在此代码的第一列中何处添加有关插入名称的部分，以及该代码是否确实按字母顺序排序。

提前感谢您的帮助！

帖子中marg的原始代码：

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

用按钮按字母顺序插入一行，在动态范围内单击并复制公式和格式

0 个答案: