1

希望我下面描述的问题是一个简单的问题。我对 VBA 还是很陌生，似乎无法越过我目前的墙……学习方面的好日子和坏日子。不幸的是，这周让我不知如何继续前进。

下面显示的宏基本上将在具有 2 张工作表（MPL 和 CAD）的电子表格上运行。

  • MPL 表 = 简单的信息表
  • CAD 表包含 3 个不同宽度的表格（即第一个表格从 C 列跨越到 AE，第二个和第三个表格从 C 列跨越到 M）。所有 3 个表都在 C 列中包含项目名称。

运行宏时，它从 MPL 工作表开始，提示用户输入新项目名称，然后按字母顺序将其添加到新行中。这很好用。

下一步是 CAD 图纸。正如我所说，有3张桌子。我能够插入新项目，但它只插入到 C 列中显示新名称的表中的 1 个表中。这是我不知所措的地方。我相信我必须找到一种方法将 C 列的所有值放入某种数组中，进行计数，然后在每个实例上添加一行。

这听起来像一个合乎逻辑的计划吗？我一直在无休止地寻找一种方法来做到这一点，但似乎无法取得任何进展。"iRow = WorksheetFunction.Match(strNewProject, Range("C:C")) + 1" 方法在单个表上似乎就足够了。

任何指向正确方向的指针都值得赞赏。 

Option Explicit 'forces declaration of variables

'PROCEDURES-----------------------------------------------------------------------------------
Sub Add_Project()

'---Procedure description/Notes---------------------------------------------------------------
'Macro Overview:
    'This procedure is used to add new projects to the Planner
    'Once the macro is started, the user will be prompted for a new
    'project name.  The new name(assuming it does not already exist) will
    'be added to the 'MPL' and 'CAD' tabs.  
'Assumptions
    'This procedure assumes the list of projects are contained in
    'column B.  If you get an error, update the column #s below.

'---Variable Declarations---------------------------------------------------------------------
Dim strNewProject As String
Dim iRow As Long

'---Code--------------------------------------------------------------------------------------
'so you don't have to see the screen flicker as the code switches sheets, cells, etc.
Application.ScreenUpdating = False

'Go to the Master Project List sheet
Sheets("MPL").Select

'Input Box prompting user for Project Name
strNewProject = InputBox("Enter Project Name")
If Len(strNewProject) = 0 Then Exit Sub 'Pressed cancel

'Checks if the project already exists, displays message if true
If WorksheetFunction.CountIf(Columns("B"), strNewProject) > 0 Then
   MsgBox "Project already exists"
    Exit Sub
End If

'Add the new  value to the existing list, alphabetically
iRow = WorksheetFunction.Match(strNewProject, Columns("B")) + 1
Intersect(Range("tMPL"), Rows(iRow)).Insert _ ' tMPL is an Excel table
XlInsertShiftDirection.xlShiftDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove
Cells(iRow, "B").Value = strNewProject

'Go to the CAD sheet
Sheets("CAD").Select

'****This is where things do not work the way that I need them to*****
'Add the new  value to the existing list, alphabetically
iRow = WorksheetFunction.Match(strNewProject, Range("C:C")) + 1
Rows(iRow).EntireRow.Insert
Cells(iRow, "C").Value = strNewProject

End Sub
4

1 回答 1

1

如果您在工作表“CAD”中的表格由空白行分隔，并且表格本身在 C 列上是连续的（各个表格从头到尾没有空白），那么也许这样的事情可能对您有用。它插入一个新行作为表中的第一行，输入项目名称，然后按项目名称对表进行排序。请注意，假设“CAD”表上的表格使用标题行，并且每个表格 C 列中的标题是“项目名称”，根据需要进行调整：

Sub tgr()

    Const strHeader As String = "Project Name"

    Dim wsMPL As Worksheet
    Dim wsCAD As Worksheet
    Dim rngFound As Range
    Dim strFirst As String
    Dim strNewProject As String

    Set wsMPL = Sheets("MPL")
    Set wsCAD = Sheets("CAD")

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

    If WorksheetFunction.CountIf(wsMPL.Columns("B"), strNewProject) > 0 Then
        MsgBox "Project with name [" & strNewProject & "] already exists.", , "New Project Error"
        Exit Sub
    End If

    'Insert new line with project name and sort data
    Intersect(Range("tMPL"), wsMPL.Rows(2)).Insert
    wsMPL.Range("B2").Value = strNewProject
    Range("tMPL").Sort wsMPL.Range("B2"), xlAscending, Header:=xlGuess

    'Insert new line into each table on wsCAD with project name and sort data
    With wsCAD
        Set rngFound = .Columns("C").Find(strHeader, .Cells(.Rows.Count, "C"), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            strFirst = rngFound.Address
            Do
                rngFound.Offset(1).EntireRow.Insert xlShiftDown
                rngFound.Offset(1).Value = strNewProject
                rngFound.CurrentRegion.Sort rngFound, xlAscending, Header:=xlYes
                Set rngFound = .Columns("C").Find("Project Name", rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    End With

    Set wsMPL = Nothing
    Set wsCAD = Nothing
    Set rngFound = Nothing

End Sub
于 2013-08-15T18:18:41.677 回答