0

我正在尝试编写一个宏（VBA/编写代码的新手），它将向现有列表（Col B）添加一个值。该值由 InputBox 定义，然后按字母顺序添加到列表中。我能够让宏工作，但是我想在一个范围内添加单元格而不是整行。

我的电子表格在 A 到 K 列中有数据。这是我要插入“行”的区域。但是有一个问题。我不想将行添加到 L 到 AF 列中的另一组数据。这是我失败的地方，因为我只能插入一个完整的行。

有没有办法做到这一点？我没有遇到任何似乎有效的方法，因为插入必须根据新值在列表中的位置（按字母顺序）进行，这会阻止我选择要插入的位置。我已尝试录制宏以查看代码，但由于选择由值定义，我无法操作该输入。

这是我到目前为止的代码......可能有点笨拙，因为我还在学习。

Sub Add_Project()
Dim NewProject As String, iRow As Long, ProjRng As Range, RowRng As Range
'The ProjRng MUST represent the project column!
    Set ProjRng = Range("B:B")
'Defines the range of columns to add a row to
    Set RowRng = Range("B:K")
'Create message box for user input on project name
    NewProject = InputBox("Enter Project Name")
    If NewProject = "" Then Exit Sub
'Determines if the New Project name already exists
    iRow = Application.WorksheetFunction.Match(NewProject, ProjRng)
    If Cells(ProjRng.row + iRow - 1, ProjRng.Column) = NewProject Then
        MsgBox ("Project already exists")
Exit Sub
    End If
'Inserts a new row with containing the new Project name
    With Cells(ProjRng.row + iRow, ProjRng.Column)
        .EntireRow.Insert
        .Offset(-1, 0).Value = NewProject
    End With
Exit Sub
End Sub

我意识到宏正在做我指示它做的事情。我想操作添加“EntireRow”的部分，该部分仅添加到 A:K 列的范围内。任何关于我可以从哪里开始的建议或指示将不胜感激。谢谢！

4

1 回答 1

1 
Sub Add_Project()

    Dim strNewProject As String
    Dim iRow As Long

    strNewProject = InputBox("Enter Project Name")
    If Len(strNewProject) = 0 Then Exit Sub 'Pressed cancel

    If WorksheetFunction.CountIf(Columns("B"), strNewProject) > 0 Then
        MsgBox "Project already exists"
        Exit Sub
    End If

    iRow = WorksheetFunction.Match(strNewProject, Columns("B")) + 1
    Intersect(Range("A:K"), Rows(iRow)).Insert xlShiftDown
    Cells(iRow, "B").Value = strNewProject

End Sub
于 2013-08-08T22:03:24.120 回答