セルを検証し、エラーシートを新しいシートに書き込むマクロを作成します。

Question

データシート上に多数のバリデーションを実行するマクロを作成しようとしています（現在、我々が受け取るテンプレート。

問題が検出されると、マクロはセルの塗りつぶしを赤にフォーマットし、新しいシートのエラーレポートに問題を書き込む必要があります。エラーレポートには、Col Aのエラー行とCol Bのエラーの簡単な説明を書き込む必要があります。

以下のマクロを半分にすると、間違ったセルがすべて赤く塗りつぶされますが、エラーレポートに正しく書き込むことができません。私はそれActivecell.row使用

1）Iは、ループ（iRow）

2）私はそれを書くために得ることができないマクロとしない行を実行する前に、私がしていたアクティブセルの行を返します私はステップスルー時にlastARowパラメータを使用しようとしたのに上書きし続けますが、それは変更されません。何かが私が欠けているか、私はループ内で別のループを必要とする場合（私もこれを試してみた）

Sub CheckValidations() 

Dim iRow As Long, lastRow As Long, firstRow As Long, ARow As Long, firstARow As Long, lastARow As Long 



Application.Calculation = xlManual 
Application.DisplayStatusBar = False 
Application.ScreenUpdating = False 



    lastRow = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row 
    firstRow = 14 

    lastARow = Sheets("Errors").Range("A" & Rows.Count).End(xlUp).Row 



     'For each row check validations in specific columns 
    For iRow = lastRow To firstRow Step -1 


     'Check SubFunction Exists, if not highlight cell and write issue to 
error report 
      If Sheets("Data").Cells(iRow, 2) <> "CRO & Admin" And Sheets("Data").Cells(iRow, 2) <> "Operational Risk" And Sheets("Data").Cells(iRow, 2) <> "Global Risk Analytics" _ 
      And Sheets("Data").Cells(iRow, 2) <> "Risk Strategy" And Sheets("Data").Cells(iRow, 2) <> "Security & Fraud Risk" And Sheets("Data").Cells(iRow, 2) <> "Wholesale & Market Risk" _ 
      And Sheets("Data").Cells(iRow, 2) <> "RBWM Risk" And Sheets("Data").Cells(iRow, 2) <> "Indirects" And Sheets("Data").Cells(iRow, 2) <> "Run Risk Like a Business" _ 
      And Sheets("Data").Cells(iRow, 2) <> "Location Optimisation" Then 
       Sheets("Data").Cells(iRow, 2).Interior.Color = RGB(255, 0, 0) 'Red 
       Sheets("Errors").Cells(lastARow, 1).Value = ActiveCell.Row 'Activecell.row returns cell from before macro was initiated, not iRow 
       Sheets("Errors").Cells(lastARow, 2).Value = "Value not in dropdown/allowed" 
      End If 

      'Check Proj Start date not before 01/07/2015, if it is wirte isue to error report 
      If Sheets("Data").Cells(iRow, 6) < DateSerial(2015, 7, 1) Then 
       Sheets("Data").Cells(iRow, 6).Interior.Color = RGB(255, 0, 0) 
       Sheets("Errors").Cells(lastARow, 1).Value = ActiveCell.Row 'Activecell.row returns cell from before macro was initiated, not iRow 
       Sheets("Errors").Cells(lastARow, 2).Value = "Start date before 01/07/2015" 
      End If 

      'Check Proj End date not after 31/12/2017, if it is wirte isue to error report 
      If Sheets("Data").Cells(iRow, 6) < DateSerial(2017, 12, 31) Then 
       Sheets("Data").Cells(iRow, 6).Interior.Color = RGB(255, 0, 0) 
       Sheets("Errors").Cells(lastARow, 1).Value = ActiveCell.Row 'Activecell.row returns cell from before macro was initiated, not iRow 
       Sheets("Errors").Cells(lastARow, 2).Value = "Start date before 01/07/2015" 
      End If 

    Next iRow 


Application.Calculation = x1Automatic 
Application.DisplayStatusBar = True 
Application.ScreenUpdating = True 

End Sub 

任意の助けをいただければ幸いです、事前に感謝があるかどうかわかりません。

Answer 1

まず、私は個人的には、VBAコードの途中でアクティブなセルを参照するのが好きではありません。マクロが実行中に誤ってシートをクリックしてエラーが発生する問題がありました。あなたのコンディションですでに.Cells(iRow, #)を参照しているので、代わりに.Cells(iRow, #).Rowを使用してみませんか？

第2に、あなたの条件が欲しいものから、特定の行に2つ以上のエラーがあっても、1種類のエラーしか記録していないようです。それはあなたの意図ですか？その場合は、代わりにElse Ifステートメントを使用することを検討するとよいでしょう。そのため、マクロがデータシートの行に渡って最初にエラーを記録するだけです。

最後に、あなたのlastARowパラメータは、マクロに変更を指示していないため変更されていません。それはforループの前に設定されていますが、触れられません。エラーが書き込まれた後、エラーが検出されるたびにlastARowをインクリメントしたいと思う可能性があります。 Use lastARow = lastARow + 1

最後に、If条件の最後にエラーが発生することがあります。私はあなたのプロジェクトの終了日が2017年以前かどうかをチェックしたいと思っています。