1

以下で説明する私の問題が単純なものであることを願っています。私はまだ VBA に非常に慣れていないため、現在の壁を乗り越えることができないようです...学習に関しては良い日も悪い日もありません。残念ながら、今週は先に進む方法について途方に暮れています。

以下に示すマクロは、基本的に 2 つのシート (MPL と CAD) を含むスプレッドシートで実行されます。

  • MPL シート = 簡単な情報表
  • CAD シートには、幅が異なる 3 つのテーブルが含まれています (つまり、最初のテーブルは列 C から AE まで、2 番目と 3 番目のテーブルは列 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