有人能帮我创建一个 vba 函数来执行以下操作吗?
在工作表1我有 3 列A(product)
,B(price)
其中填充了3000 件商品第三列C(quantity)
现在尚未填充。
我想为某些产品添加数量,通过找到产品并在相应的单元格 C 中输入数量即可完成。
然后在工作表2甚至指定不同的工作簿仅添加所有引入数量的产品和价格和数量。
例如,我有工作表1:
我希望 sheet2 或指定的 sheet/工作簿自动填充产品及其匹配的价格和数量,如下所示:
我已经设法创建了一个 Excel 函数,但产品列表每周都在变化,每次我都必须复制/粘贴公式并调整源文件,这非常麻烦。
我制定的公式如下:
=IFERROR(INDEX('Products'!$A$5:$C$2655,SMALL(IF((0<'Products'!$C$5:$C$2655),MATCH(ROW('Products'!$B$5:$B$2655),ROW('Products'!$B$5:$B$2655))),ROW(A11)),COLUMN(A11))," ")
答案1
此 VBA 代码将起作用:
Public Sub quantityProducts()
'**********************
' variables
sourceSheet = "Sheet1" 'name of the source sheet
destSheet = "Sheet2" 'name of the destination sheet
titleRow = 1 ' Number of Title Row
firstRowSource = 2 ' First row of source data
firstRowDest = 2 'First row of data in destination sheet
copyTitleRow = True 'Should be title row be copied? True / False
columnToCheck = 3 'Column that defines if the row must be copied
'**********************
Dim wkb As Workbook
Dim wks, wks1 As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets(sourceSheet)
Set wks1 = wkb.Worksheets(destSheet)
wks1.Rows.Clear ' Clear the contents of destination sheet
If copyTitleRow = True Then 'If title row must be copied
wks.Rows(titleRow).Copy Destination:=wks1.Rows(titleRow)
End If
totalrows = wks.Cells(Rows.Count, 1).End(xlUp).Row ' total rows in source
destRow = firstRowDest
For i = firstRowSource To totalrows ' iterate through rows
If wks.Cells(i, columnToCheck) <> "" Then ' If cell in column to check isn't empty
wks.Rows(i).Copy Destination:=wks1.Rows(destRow) ' Copy from source to destination
destRow = destRow + 1 ' Increase value of destination row
End If
Next i
a = MsgBox("Finished. Copied " & destRow - firstRowDest & " rows", vbOKOnly)
End Sub
使用ALT+打开 VBA/宏F11,在本工作簿插入一个新的模块并将代码粘贴在右侧。
检查分配给变量的值是否与您的工作表匹配,然后单击绿色三角形执行它。
我对代码进行了注释,以便您了解它是如何工作的。
您也可以通过单击第一行然后按 执行每个步骤来逐步运行它F8。