Question

我正在尝试编写一个宏（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。关于我可以开始的任何建议或指示将非常感激。谢谢！

Answer 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

仅将单元格添加到列范围

1 个答案: