用于发票的Excelmacros

所以这个供应商每周都会向我发送电子表格以获得他们的发票。 在名字colum中，如果它等于“BCR Plaza”，我想让excel自动在下面添加一行，复制前一行的一些数据，并将原始行中的总数除以2.我已经有一个macros这个的。 我不能弄清楚的是如何告诉excel，以上所有的行为都执行完毕后再回到原来的总数，并且把它们分开，并用结果代替。

这是我现在有的macros：

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 

原始文件

macros后

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