Fatal编程技术网
  • excel/
  • Excel 扩展vlookup计算货物成本

Excel 扩展vlookup计算货物成本

excel excel-formula vba

Excel 扩展vlookup计算货物成本,excel,excel-formula,vba,Excel,Excel Formula,Vba,我有网上商店的销售报告，需要计算每个订单行的商品成本。订单行可以类似于以下命令之一： 2x拉瓦扎乳酪e Aroma 1kg-1x拉瓦扎杜尔塞咖啡乳酪1kg 1x拉瓦扎自动售货机香气顶级1公斤-1x阿卡夫罗马1公斤-1x金宝-100%阿拉比卡顶级风味 所以，我需要Excel做的是从另一张表中取出每个产品，用vlookup函数找到它的成本，然后将它乘以订购的数量。问题是订购的产品数量可能从1到10+不等。 我试着用VBA计算，但代码不起作用（我知道，我当时没有使用乘法） 也许可以用excel公式解决

我有网上商店的销售报告，需要计算每个订单行的商品成本。订单行可以类似于以下命令之一：

2x拉瓦扎乳酪e Aroma 1kg-1x拉瓦扎杜尔塞咖啡乳酪1kg

1x拉瓦扎自动售货机香气顶级1公斤-1x阿卡夫罗马1公斤-1x金宝-100%阿拉比卡顶级风味

所以，我需要Excel做的是从另一张表中取出每个产品，用vlookup函数找到它的成本，然后将它乘以订购的数量。问题是订购的产品数量可能从1到10+不等。 我试着用VBA计算，但代码不起作用（我知道，我当时没有使用乘法） 也许可以用excel公式解决这个问题

Function GoodsCost(str, Optional strDelim As String = " ")
larray = Split(str, strDelim)
Set lookup_range = Worksheets("Products").Range("B:E")
For i = LBound(larray) To UBound(larray)
    skuarray = Split(larray(i), "x ")
    skucost = Application.WorksheetFunction.VLookup(UBound(skuarray), lookup_range, 4, False)
    cost = cost + skucost
Next i
GoodsCost = cost
End Function
看来现在问题解决了。当然，只有假设产品描述中不存在破折号（-）时，它才会起作用。但它可以在产品列表中设置。另一个机会是使用另一个delimeter（例如“/”）。我们可以使用Ctrl+F查找所有组合，如“x-”，并将其替换为“x/”）

下面是可以在工作表中使用的UDF（用户定义函数）。将其安装在标准代码模块（VBE将其命名为“Module1”）中后，您可以从工作表中调用它，如
=CostOfGoods（$A2）
所述，其中A2是包含和订单行的单元格

Option Explicit

Function CostOfGoods(Cell As Range) As Single
    ' 15 Jan 2018

    Const Delim As String = " - "

    Dim Fun As Single                   ' function return value
    Dim Sale As Variant
    Dim Sp() As String
    Dim i As Long
    Dim PriceList As Range
    Dim Qty As Single, Price As Single
    Dim n As Integer

    Sale = Trim(Cell.Value)
    If Len(Sale) Then
        Sp = Split(Sale, Delim)
        Do While i <= UBound(Sp)
            If InStr(Sp(i), "x ") = 0 Then
                If Not ConcatSale(Sp, i, Delim) Then Exit Do
            End If
            i = i + 1
        Loop

        With Worksheets("Products")
            i = .Cells(.Rows.Count, "B").End(xlUp).Row
            ' price list starts in row 2 (change as required)
            Set PriceList = Range(.Cells(2, "B"), .Cells(i, "E"))
        End With

        For i = 0 To UBound(Sp)
            Qty = Val(Sp(i))
            n = InStr(Sp(i), " ")
            Sp(i) = Trim(Mid(Sp(i), n))
            On Error Resume Next
            Price = Application.VLookup(Sp(i), PriceList, 4, False)
            If Err Then
                MsgBox "I couldn't find the price for" & vbCr & _
                       Sp(i) & "." & vbCr & _
                       "The total cost calculated excludes this item.", _
                       vbInformation, "Price not found"
                Price = 0
            End If
            Fun = Fun + (Qty * Price)
        Next i
    End If

    CostOfGoods = Fun
End Function

Private Function ConcatSale(Sale() As String, _
                            i As Long, _
                            Delim As String) As Boolean
    ' 15 Jan 2018

    Dim Fun As Boolean                  ' function return value
    Dim x As Long, f As Long

    x = UBound(Sale)
    If (i > 0) And (i <= x) Then
        i = i - 1
        Sale(i) = Sale(i) & Delim & Sale(i + 1)
        For f = i + 1 To x - 1
            Sale(f) = Sale(f + 1)
        Next f
        Fun = True
    End If

    If Fun Then ReDim Preserve Sale(x - 1)
    ConcatSale = Fun
End Function

选项显式
单个商品的功能成本（单元格作为范围）
2018年1月15日
Const Delim As String=“-”
Dim Fun作为单个函数返回值
变型销售
将Sp（）设置为字符串
我想我会坚持多久
将价格表设置为范围
单件订货数量，单件价格
作为整数的Dim n
销售=修剪（单元格值）
如果Len（销售）那么
Sp=拆分（销售、Delim）

我已经测试过了，它可以与产品描述中的破折号配合使用：


Function GoodsCost(str, Optional strDelim As String = " ")
larray = Split(str, " ")
'split the cell contents by space
Set lookup_range = Worksheets("Products").Range("B:E")
'set lookup range
For i = LBound(larray) To UBound(larray) 'loop through array
nextproduct:
    LPosition = InStr(larray(i), "x") 'find multiplier "x" in string
    If LPosition = Len(larray(i)) Then 'if the last character is x
        If Product <> "" Then GoTo lookitup 'lookup product
        Quantity = larray(i) 'get quantity
    Else
        Product = Product & " " & larray(i) 'concatenate array until we get a full product description to lookup with
    End If
Next i
lookitup:
If Right(Product, 2) = " -" Then Product = Left(Product, Len(Product) - 2)
If Left(Product, 1) = " " Then Product = Right(Product, Len(Product) - 1)
'above trim the Product description to remove unwanted spaces or dashes
cost = Application.WorksheetFunction.VLookup(Product, lookup_range, 4, False)
Quantity = Replace(Quantity, "x", "")
GoodsCost = cost * Quantity
MsgBox Product & " @ Cost: " & GoodsCost
Product = ""
If i < UBound(larray) Then GoTo nextproduct
End Function



函数GoodsCost（str，可选strDelim为String=”“）
larray=拆分（str，“”）
'按空间分割单元格内容
设置查找范围=工作表（“产品”）。范围（“B:E”）
'设置查找范围
对于i=LBound（larray）到UBound（larray）'循环通过数组
下一个产品：
LPosition=InStr（larray（i），“x”）'在字符串中查找乘数“x”
如果LPosition=Len（larray（i）），则“如果最后一个字符是x
如果是产品“”，则转到lookitup查找产品
数量=拉雷（i）'获取数量
其他的
Product=Product&&&larray（i）连接数组，直到我们获得完整的产品描述以进行查找
如果结束
接下来我
lookitup：
如果右（产品，2）=“-”，则产品=左（产品，透镜（产品）-2）
如果左（产品，1）=“”，则产品=右（产品，透镜（产品）-1）
'上面修剪产品说明以删除不需要的空格或破折号
成本=Application.WorksheetFunction.VLookup（产品，查找范围，4，False）
数量=替换（数量，“x”、“”）
货物成本=成本*数量
MsgBox产品和@Cost:&GoodsCost
Product=“”
如果我
我会用正则表达式来解决这个问题。首先在字符串中找到的是“分隔符”，它们是通过将
-
替换为
仅检测紧跟在一个数字之后的
-
（即，在产品名称中忽略
-
的乘数）的
-
。然后，它将每个结果拆分为数量和乘积（再次使用正则表达式）。然后，它在您的数据中查找产品并返回商品成本。如果有错误，或者产品不在您的数据中，它将返回一个
#值
错误以表明存在问题


Public Function GoodsCost(str As String) As Double
    Dim lookup_range As Range, ProductMatch As Range
    Dim v, Match
    Dim qty As Long
    Dim prod As String
    Dim tmp() As String

    On Error GoTo err

    Set lookup_range = Worksheets("Products").Range("B:E")

    With CreateObject("vbscript.regexp")
        .Global = True
        .ignorecase = True

        .pattern = "(\s\-\s)(?=[0-9]+x)"
        If .test(str) Then
            tmp = Split(.Replace(str, ";"), ";")
        Else
            ReDim tmp(0)
            tmp(0) = str
        End If
        .pattern = "(?:([0-9]+)x\s(.+))"
        For Each v In tmp
            If .test(v) Then
                Set Match = .Execute(v)
                qty = Match.Item(0).submatches.Item(0)
                prod = Trim(Match.Item(0).submatches.Item(1))
                Set ProductMatch = lookup_range.Columns(1).Find(prod)
                If Not ProductMatch Is Nothing Then
                    GoodsCost = GoodsCost + (qty * ProductMatch.Offset(0, 3))
                Else
                    GoodsCost = CVErr(xlErrValue)
                End If
            End If
        Next v
    End With
Exit Function
err:
    GoodsCost = CVErr(xlErrValue)
End Function



2x Lavazza Crema e Aroma 1kg-1x Lavazza Dolce Caffe Crema 1kg
是单个细胞的含量吗？是否有多个项目用破折号（-）分隔？是否有任何产品说明包含破折号（-）？您是否有精确匹配的产品描述，如
拉瓦扎乳酪e Aroma 1kg
？是的，在单个单元格中。多个项目用破折号（-）分隔。一些产品在说明中包含破折号：-（是的，在产品表中说明精确匹配是数量始终在开始处（在产品名称之前）并后跟x？是的，始终。我认为可以用更独特的符号替换分隔符，如“/”或删除所有破折号“-”来自产品名称。请检查我的答案，因为即使在产品描述中使用破折号也可以：

Public Function GoodsCost(str As String) As Double
    Dim lookup_range As Range, ProductMatch As Range
    Dim v, Match
    Dim qty As Long
    Dim prod As String
    Dim tmp() As String

    On Error GoTo err

    Set lookup_range = Worksheets("Products").Range("B:E")

    With CreateObject("vbscript.regexp")
        .Global = True
        .ignorecase = True

        .pattern = "(\s\-\s)(?=[0-9]+x)"
        If .test(str) Then
            tmp = Split(.Replace(str, ";"), ";")
        Else
            ReDim tmp(0)
            tmp(0) = str
        End If
        .pattern = "(?:([0-9]+)x\s(.+))"
        For Each v In tmp
            If .test(v) Then
                Set Match = .Execute(v)
                qty = Match.Item(0).submatches.Item(0)
                prod = Trim(Match.Item(0).submatches.Item(1))
                Set ProductMatch = lookup_range.Columns(1).Find(prod)
                If Not ProductMatch Is Nothing Then
                    GoodsCost = GoodsCost + (qty * ProductMatch.Offset(0, 3))
                Else
                    GoodsCost = CVErr(xlErrValue)
                End If
            End If
        Next v
    End With
Exit Function
err:
    GoodsCost = CVErr(xlErrValue)
End Function