因此,这家供应商每周都会向我发送电子表格以供发票使用。在名称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
答案 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