在列中find匹配项时如何插入行？
希望下面描述的我的问题是一个简单的问题。 我对VBA还是一个新鲜的东西，似乎无法摆脱我目前的困境……学习方面的好日子和坏日子。 不幸的是，本周让我不知如何继续前进。
下面显示的macros将基本上运行在一个有2张（MPL和CAD）的电子表格上。
- MPL表=简单的信息表
- CAD工作表包含3个不同宽度的表格（即第一个表格从C列到AE，第二个和第三个表格从C列到M）。 所有3个表格都包含C列中的项目名称。
当macros运行时，它从MPL表单开始，提示用户input一个新的项目名称，然后按照字母顺序将其添加到一个新的行中。 这很好。
下一步是CAD工作表。 正如我所说，有3个表格。 我可以插入新的项目，但是只能插入到列C中新名称所示的表格中的一个中。这就是我不知所措的地方。 我相信我必须find一种方法来将列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 如果工作表“CAD”中的表被一个空行分开，并且表本身在C列上是连续的（对于各个表而言，从开始到结束都没有空白），那么可能是这样的。 它将在表中插入一行作为第一行，放入项目名称，然后按项目名称对表格进行sorting。 请注意，工作表“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