根据给定条件的总和范围从一列返回值

Posted 2023-04-14

【中文标题】根据给定条件的总和范围从一列返回值

【英文标题】：Return values from one column based on sum range for given criteria

【发布时间】：2021-08-19 09:45:50

【问题描述】：

我有一个包含A、B 和C 列的表，列中的所有值都按升序排列。 Column A 有序列号，column B 有名称，column C 有数量。

当我在cell L2 和cell M2 所需数量中输入名称时，假设为540，宏应从column B 中的cell L2 中搜索名称，并将该名称的所有值求和，直到总和与值匹配来自cell M2。当 sum 匹配时，从 column N 中的 sum 范围复制（返回）column A 中的所有序列号。

我手动做了一个例子，它应该是什么样子。

我在另一个论坛上提出了同样的问题，但没有答案 (https://www.mrexcel.com/board/threads/reverse-sumif-return-column-values-based-on-sum-criteria.1179552/)

【问题讨论】：

代码应该如何知道它要查找的是 L2 还是 L3 等。它将只是 L 列中的最后一行，还是 L 列中的所有项目的总和？那么颜色又是怎么回事？

您好，只有搜索值在 L2 中，我添加了绿色值 (L3) 和颜色只是为了更详细的解释。米尔科

那么在添加新列表之前需要清除N列吗？

那太好了。如果需要，这里是示例工作簿的链接：easyupload.io/8k12xq

最后一件事是它与 M2 完全匹配还是最接近？如果不完全匹配怎么办？

【参考方案1】：

看看这对你有什么作用：

Sub GetSerialNo()

Dim ws As Worksheet, lRowInput As Long, lRowResults As Long, i As Long
Dim arr, SName As String, SQuantity As Double, CurQuantity As Double
Dim MatchList(), MatchCount As Long

Set ws = Sheets("Blanko List") 'Your sheet name
lRowInput = ws.Range("A" & Rows.Count).End(xlUp).Row 'Last row of data
lRowResults = ws.Range("N" & Rows.Count).End(xlUp).Row 'Last row of previous results
arr = ws.Range("A2:C" & lRowInput).Value 'Populate the array
SName = ws.Range("L2").Value 'Search name
SQuantity = ws.Range("M2").Value 'Search Quantity
CurQuantity = 0 'Ensure these 2 values are 0
MatchCount = 0

For i = 1 To UBound(arr, 1) 'Loop from row 1 to last row
    If arr(i, 2) = SName Then 'If name = search name
        If arr(i,3) > 0 Then 'New line to skip quantities of 0
            CurQuantity = CurQuantity + arr(i, 3) 'add quantity
            MatchCount = MatchCount + 1 'Add match count
            ReDim Preserve MatchList(1 To MatchCount) 'Resize the matchlist array to add a new row
            MatchList(UBound(MatchList)) = arr(i, 1) 'Add the name to new row of matchlist
            If CurQuantity >= SQuantity Then Exit For 'If the quantity is equal or greater than search quantity then exit the loop
        End if 
    End If
Next i

ws.Range("N2:N" & lRowResults + 1).ClearContents 'Clear previous results list
ws.Range("N2").Resize(UBound(MatchList)).Value = Application.Transpose(MatchList) 'Dump new results into column N
If CurQuantity < SQuantity Then
    MsgBox "The available quantity is less than the desired quantity." & vbCr & vbCr & _
    "Desired: " & SQuantity & vbCr & "Available: " & CurQuantity & vbCr & _
    "Difference: " & CurQuantity - SQuantity, vbExclamation, "Missing Quantities"
End If

End Sub

我已在每一行中添加了 cmets，因此您希望可以按照它正在做的事情进行操作。

如果可用数量少于所需数量，我也刚刚添加了检测。您显然可以将消息框的内容完全更改为您想要的内容。

【讨论】：

代码就像维也纳爱乐乐团一样工作：D 谢谢你帮我度过了美好的时光。

不用担心。乐于助人。

我应该指出，如果您要求的数量大于列表中的数量，那么它会给您全部，但显然会缺少多少。一个简单的插件就可以解决这个问题。

试试新代码。您显然还需要将 xlsx 文件类型更改为 xlsm 以保存宏，但如果您还没有尝试，Excel 会告诉您。

您好，我更新了，只需添加行If arr(i,3) > 0 Then 和对应的End If。让我知道这是否有效。