Question

您可以看到第一张图片中Amount列中的值是手动输入的。我想用VBA自动完成。

表B546789是工作人员之一：

IMG1 - Table B546789 is one of the worker

PriceList显示了每个代码项的数量：

IMG2 - PriceList shown the amount of each code item

代码：

Sub FINDSAL()
    Dim E_name() As String
    Dim Sal As String
    Dim sheet As Worksheet
    Set sheet = ActiveWorkbook.Sheets("PriceList")
    SourceString = Worksheets("B546789").Range("B2").Value
    E_name() = Split(SourceString, ",")
    Sal = Application.WorksheetFunction.VLookup(E_name, Worksheets("PriceList").Range("A2:B7"), 2, False)
End Sub

Answer 1

一个简单的SUMPRODUCT应该这样做。

=SUMPRODUCT(--ISNUMBER(FIND(F$2:F$8, B2)), G$2:G$8)

VBA代码：

Dim a As Long, b As Long, ttl As Double
Dim vals As Variant, pc As Variant
Dim sh As Worksheet

Set sh = ActiveWorkbook.Sheets("PriceList")

With Worksheets("B546789")
    For b = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
        ttl = 0
        vals = Split(.Cells(b, "B").Value2, Chr(44))
        For a = LBound(vals) To UBound(vals)
            pc = Application.Match(vals(a), sh.Columns(1), 0)
            If Not IsError(pc) Then
                ttl = ttl + sh.Cells(pc, "B").Value2
            End If
        Next a
        .Cells(b, "C") = ttl
    Next b
End With

Answer 2

任何提示，当我把下面的代码放到VBA ThisWorkbook，工作正常。但是将这个Marco分配给一个按钮，它会在我运行时崩溃。你知道为什么吗？

子测试（）

Dim a As Long, b As Long, ttl As Double, ttlerror As String
Dim vals As Variant, pc As Variant
Dim sh As Worksheet
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant


Set sh = ActiveWorkbook.Sheets("PriceList")
WshtNames = Array("B54546", "B87987")

For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
    For b = 8 To [D8].End(xlDown).Row
        ttl = 0
    ttlerror = ""
        vals = Split(.Cells(b, "D").Value2, Chr(44))
        For a = LBound(vals) To UBound(vals)
            pc = Application.Match(vals(a), sh.Columns(1), 0)
            If Not IsError(pc) Then
                ttl = ttl + sh.Cells(pc, "B").Value2
            End If
        Next a
        .Cells(b, "E") = ttl
    .Cells(b, "F") = ttlerror
    Next b
End With
Next WshtNameCrnt

End Sub

问题可能与此相关“For b = 8 To [D8] .End（xlDown）.Row”，它只发生在我使用按钮功能时。 Image here

完成cal，求和vlookup值

2 个答案: