VBAでの新しい行グリッチの追加

Question

スプレッドシートのセクション内の行の範囲に新しい行を追加する次のコードを記述しました。これらのセクションのいくつかがあるので、sBudgetLineは範囲（セクション名）の開始値として渡され、セクションのヘッダー（日付、説明、および価格）を見逃すために余分に1が加えられます。

すべて正常に動作しますが、行が追加されるときに、ハードコードされた書式設定が機能せず、適切な場所にある新しい行だけでなくページの下に余分な行が追加されます。

Sub AddNewAllocToSpendLine(sBudgetLine As String, Optional sSheetName As String = c_Alloc2SpendSheetName) 

Dim c As Range 
Dim N As Long 
Dim lastRow As Long 
Dim formula As Range 
Dim rng As Range 

With Worksheets(sSheetName) 

    Set c = .Columns(1).Find(sBudgetLine, LookIn:=xlValues) 
    If Not (c Is Nothing) Then 

     lastRow = .Cells(c.Row, 2).End(xlDown).Row 

     Worksheets(sSheetName).Activate 
     Worksheets(sSheetName).Range("B" & lastRow + 1, "E" & lastRow + 1).Activate 

     Selection.EntireRow.Insert Shift:=xlDown 

     Selection.Range("B" & ActiveCell.Row, "E" & ActiveCell.Row).Interior.Color = RGB(255, 255, 255) 

     With Selection.Range("B" & ActiveCell.Row, "D" & ActiveCell.Row).Borders 
       .LineStyle = xlContinuous 
       .Weight = xlThin 
       .ColorIndex = 1 
      End With 

     Selection.Cells(1, 4).formula = "=IF(" & "D" & ActiveCell.Row & "="""","""",IF(" & "D" & ActiveCell.Row & ">14999.99,""Minimum 3 formal competitive tenders - inform PSU"",IF(" & "D" & ActiveCell.Row & ">2499.99,""Minimum 3 written quotes based on written specification"",IF(" & "D" & ActiveCell.Row & ">999.99,""Minimum 3 written quotes"",IF(" & "D" & ActiveCell.Row & ">499.99,""Minimum 3 oral quotes"",IF(" & "D" & ActiveCell.Row & ">249.99,""One written or verbal quote"",""One written or verbal quote""))))))" 

    End If 
End With 
End Sub 

私はすべての種類を試してみましたし、いただきました間違って理解することはできません、これはVBAグリッチだろうか？この場合、追加された行に書式設定を提供するより良い方法はありますか？

Answer 1

親ワークシートを参照しているWith ... End With statementを使い始めると、それを放棄したようです。 .Activateにしたいセルを含むより大きなセルブロックがすでに.Selectionである場合、選択は変更されず、ActiveCell propertyのみが変更されます。

Range .SelectメソッドとRange .Activateメソッドを使用することは避けてください。

Sub AddNewAllocToSpendLine(sBudgetLine As String, Optional sSheetName As String = c_Alloc2SpendSheetName) 

    Dim rw As Variant, nr As Long 

    With Worksheets(sSheetName) 
     rw = Application.Match(sBudgetLine, .Columns(1), 0) 
     If Not IsError(rw) Then 
      nr = .Cells(rw, "B").End(xlDown).Row + 1 
      .Rows(nr).EntireRow.Insert Shift:=xlDown 
      With .Range(.Cells(nr, "B"), .Cells(nr, "E")) 
       .Interior.Color = RGB(255, 255, 255) 
       With .Borders 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = 1 
       End With 
       .Cells(1, 4).formula = _ 
        "=IF(D" & nr & "=TEXT(,), TEXT(,), " & _ 
        "IF(D" & nr & ">14999.99, ""Minimum 3 formal competitive tenders - inform PSU"", " & _ 
        "IF(D" & nr & ">2499.99, ""Minimum 3 written quotes based on written specification"", " & _ 
        "IF(D" & nr & ">999.99, ""Minimum 3 written quotes"", " & _ 
        "IF(D" & nr & ">499.99, ""Minimum 3 oral quotes"", " & _ 
        "IF(D" & nr & ">249.99, ""One written or verbal quote"", " & _ 
         """One written or verbal quote""))))))" 
      End With 
     End If 

    End With 
End Sub 

TEXT(,)文字列で""""としてそれを記述することなく、""を書くだけの方法です。

---

.¹_{は、選択に頼るから離れるの詳細な方法についてHow to avoid using Select in Excel VBA macrosを参照してくださいとあなたの目標を達成するために有効にします。}