Excel宏添加新行

时间:2017-08-07 14:20:15

标签: excel vba excel-vba spreadsheet

我有一个项目,我正在努力,我需要一些vba魔法的帮助。

最终我希望代码为我做的是,如果某个范围内的某个值等于特定的字符串或数字,那么就举个例子说" Bananas"然后在下面添加一个新行,而不是空白行但具有特定值,然后将原始行的总$拆分为50%并将其添加到新行并返回调整原始行,现在显示50%而不是总数它最初显示的数量。

对不起我的英语,不是很好。请看下面的图片。

enter image description here

所以现在在那行下面我想添加另一个新行

Name : Store B 
Delivery Date : Same 
Memo : Same
Invoice Number : Same 
Total : 50% of total of Store A row

此外,在添加总数之后,我还想要公式来调整原始商店A行的总数。

这是我迄今为止能够构建的宏。如果A1等于" Store A"我可以让它添加一个空行。但我不能让它添加所有其他要求。

宏:

Sub BlankLine()
    'Updateby20150203
    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "Add New Row"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    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 = "Store A" Then
            Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

提前感谢您提供的任何帮助!

1 个答案:

答案 0 :(得分:0)

我会使用变量来定义您需要的每个信息,然后将其分配给新行(我必须道歉,我的浏览器没有显示您发布的图像,因此列引用可能是错误的。您可以轻松地更改它们以匹配您的工作表。):

Sub BlankLine()
    'Updateby20150203
    Dim Rng As Range
    Dim WorkRng As Range
    Dim dt As String
    Dim memo As String
    Dim invoice As String
    Dim total As Variant

    On Error Resume Next
    xTitleId = "Add New Row"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    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 = "Store A" Then
                dt = Range("B" & xRowIndex).Value
                invoice = Range("D" & xRowIndex).Value
                memo = Range("E" & xRowIndex).Value
                total = (Range("F" & xRowIndex).Value) / 2
            Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
                Range("A" & xRowIndex + 1) = "Store B"
                Range("B" & xRowIndex + 1) = dt
                Range("C" & xRowIndex + 1) = invoice
                Range("D" & xRowIndex + 1) = memo
                Range("E" & xRowIndex + 1) = total
                Range("E" & xRowIndex) = total
        End If
    Next
    Application.ScreenUpdating = True
End Sub
相关问题