Excel 添加新行的宏

Question

我有一个正在进行的项目，我需要一些 vba 魔法方面的帮助。

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

抱歉我的英语不是很好。请看下图。

所以现在在该行下方我想添加另一个新行说

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

此外，在添加总计之后，我还想使用公式来调整原始 Store 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

在此先感谢您提供的任何帮助！

Answer 1

我会使用变量来定义您需要的每条信息，然后像这样将其分配给新行（我必须道歉，我的浏览器没有显示您发布的图片，所以列引用可能错了。您可以轻松更改它们以匹配您的工作表。):

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

Excel 添加新行的宏

Excel Macro to add new row

excel

vba

spreadsheet