Excel VBA - 挿入された行が下部の代わりに選択範囲の上部に表示される

Question

トランザクションのブロックを見て、月間に3行を挿入し、月と小計を追加するこのマクロを使用しています。問題は、ブレークとトータルが終了の代わりに月の初めに挿入されることです。

私はシフトを調整しようとしましたが、エラーが発生するか、新しい行に移動する代わりに既存のセルをオーバーライドしてしまいます。これは私が以前に勉強したよりも複雑なマクロです。私は少し失われていますが、まだVBAを学んでいます。

Option Explicit 

Sub AddAndSum() 

On Error GoTo lblError 
Application.DisplayAlerts = False 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

Dim shData As Worksheet, wbData As Workbook 
Dim fr As Long, lr As Long, i As Long, lr2 As Long 
Dim intMonth As Long, intYear As Long 

Set wbData = ThisWorkbook 
Set shData = wbData.Sheets("Sheet1") 
fr = 13 
lr = shData.Rows.Count 

For i = fr To lr 
    With shData 
     If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then 
      intMonth = Month(.Cells(i, 3).Value) 
      intYear = Year(.Cells(i, 3).Value) 
      .Rows(i & ":" & i + 2).Insert Shift:=xlDown 
      .Cells(i + 1, 1).Value = "Monthly Total (" & MonthName(intMonth) & ")" 
      .Cells(i + 1, 2).Formula = "=SUMPRODUCT((MONTH($C$" & fr & ":$C$" & lr & ")=" & intMonth & ")*(YEAR($C$" & fr & ":$C$" & lr & ")=" & intYear & ")*$E$" & fr & ":$E$" & lr & ")" 
      i = i + 3 
     End If 
    End With 
Next i 

lblError: 
If Err.Number <> 0 Then 
    MsgBox "Error (" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical 
End If 
GoTo lblExit 

lblExit: 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
Application.Calculate 
Application.Calculation = xlCalculationAutomatic 
Exit Sub 

End Sub 

Answer 1

この行は、行iで挿入を開始します。

.Rows(i & ":" & i + 2).Insert Shift:=xlDown 

あなたが行i+3で挿入を開始する、とあなたはOffset方法であることを達成することができます

.Rows(i & ":" & i + 2).Offset(3).Insert Shift:=xlDown 

ます。また、「最後を得るための最善の方法について、この答えを見てみたいことがあり列の行」：

Error in finding last used cell in VBA

あなたは、現在65あるlr = shData.Rows.CountをやっているとExcel 2003で336行、またはExcel 2007+で1,048,576行になっていて、それほど多くのデータがない（そうでなければInsertが失敗する！）ので、ループは空の行の上に不必要に循環しています。それは来月の最初のセルである現在のセルの値（にintMonthを設定している瞬間に

intMonth = Month(.Cells(i, 3).Value) 

intMonth = Month(.Cells(i-1, 3).Value) 

へ：

Answer 2

あなたは、この行を変更する必要があります）の代わりに、前のセルの値（小計したい月が含まれています）を使用します。

ループに条件を追加して、最後の小計を追加します。また

：

If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then 

これはi = lrべきか？あなたはシートの最後の行をチェックしていますか？現時点では、常に最初の行の後に小計を入れます。 3つの小計線を追加するときにこの値を更新する必要があります。