請求書用のExcelマクロ

Question

したがって、毎週、請求書のためにスプレッドシートを送付するベンダーがいます。名前の列では、 "BCRプラザ"と同じ場合は、私は自動的にその下に別の行を追加するには、前の行からいくつかのデータをコピーし、元の行の合計を2で割るに優れていると思います。私はすでにこれの。私が把握できないのは、上記のすべてのアクションが実行された後で元の合計に戻ってそれをさらに分割して結果に置き換えることを教える方法です。

これは私が現在、今持っているマクロです。これを試してみてください

Sub BlankLine() 

Dim Rng As Range 
Dim WorkRng As Range 
Dim Name As String 
Dim Memo As String 
Dim dn As Variant 
Dim dt As Variant 
Dim Total As Variant 

On Error Resume Next 
xTitleId = "Add New Row" 
Set WorkRng = Application.Selection 
Set WorkRng = Cells.Select 
Set WorkRng = WorkRng.Columns(1) 
xLastRow = WorkRng.Rows.Count 
Application.ScreenUpdating = False 
For xRowIndex = xLastRow To 1 Step -1 
    Set Rng = WorkRng.Range("A" & xRowIndex) 
    If Rng.Value = "BCR Plaza" Then 
      dt = Range("B" & xRowIndex).Value 
      dn = Range("D" & xRowIndex).Value + 0.5 
      Memo = Range("C" & xRowIndex).Value 
      Total = (Range("I" & xRowIndex).Value)/2 
     Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown 
      Range("A" & xRowIndex + 1) = "Billing" 
      Range("D" & xRowIndex + 1) = dn 
      Range("B" & xRowIndex + 1) = dt 
      Range("C" & xRowIndex + 1) = Memo 
      Range("I" & xRowIndex + 1) = Total 

    End If 
Next 
Application.ScreenUpdating = True 
End Sub 

オリジナルファイル

マクロ

Answer 1

後...

Sub BlankLine() 
Dim Memo As String 
Dim dn As Variant 
Dim dt As Variant 
Dim Total As Variant 
Dim xRowIndex As Long, xLastRow As Long 

Application.ScreenUpdating = False 
xLastRow = Cells(Rows.Count, 1).End(xlUp).Row 
For xRowIndex = xLastRow To 2 Step -1 
    If Cells(xRowIndex, 1) = "BCR Plaza" Then 
     dt = Range("B" & xRowIndex).Value 
     dn = Range("D" & xRowIndex).Value + 0.5 
     Memo = Range("C" & xRowIndex).Value 
     Total = (Range("I" & xRowIndex).Value)/2 
     Rows(xRowIndex + 1).Insert 
     Range("A" & xRowIndex + 1) = "Billing" 
     Range("D" & xRowIndex + 1) = dn 
     Range("B" & xRowIndex + 1) = dt 
     Range("C" & xRowIndex + 1) = Memo 
     Range("I" & xRowIndex + 1) = Total 
     Range("I" & xRowIndex) = Total 
    End If 
Next 
Application.ScreenUpdating = True 
End Sub