Excel宏用于发票

时间:2017-08-17 13:34:08

标签: excel vba excel-vba

因此,这家供应商每周都会向我发送电子表格以供发票使用。在名称colum中,如果它等于“BCR Plaza”,我希望excel在其下方自动添加另一行,复制前一行的一些数据并将原始行中的总数除以2.我已经有一个宏用于所有这个的。我无法弄清楚的是如何告诉excel在执行完所有上述操作后返回到原始总数并将其除以并将其替换为结果。

这是我现在拥有的宏:

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

原始文件 enter image description here

宏观之后 enter image description here

1 个答案:

答案 0 :(得分: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