我有一个项目,我正在努力,我需要一些vba魔法的帮助。
最终我希望代码为我做的是,如果某个范围内的某个值等于特定的字符串或数字,那么就举个例子说" Bananas"然后在下面添加一个新行,而不是空白行但具有特定值,然后将原始行的总$拆分为50%并将其添加到新行并返回调整原始行,现在显示50%而不是总数它最初显示的数量。
对不起我的英语,不是很好。请看下面的图片。
所以现在在那行下面我想添加另一个新行
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
提前感谢您提供的任何帮助!
答案 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