根据选择进行搜索和求和答案

【问题标题】：Search and Sum based on selection根据选择进行搜索和求和
【发布时间】：2010-10-18 15:15:55
【问题描述】：

我试过 Sum、CountIf、Dsum、SumProduct

我有一个带有组合框“History_Select_Debtor”的用户表单。 ComboBox 的 RowSource 是“Debtor_list_Debtors” - 工作表“DebtorList”上的动态命名范围。它由 A2:A24 中的客户名称组成，但最终会增长。

用户窗体还有一个名为“txtPurchased”的总购买项目的文本框。

每笔交易都会在包含 7 列的工作表“InvoiceList”中保存一条记录。

每一列都有动态命名范围

A = "Debtor" (Invoice_list_Debtor)
B = "Item" (Invoice_list_Item)
C = "Price" (Invoice_list_Price)
D = "Date" (Invoice_list_Date)
E = "Time" (Invoice_list_Time)
F = "Balance" (Invoice_list_Balance)
G = "Payed" (InvoiceList_Payed)

Item 列中保存的记录是文本；

“已付余额”、“已添加余额”、“季度商品”、“半商品”、“1 商品”-“10 商品”

我需要“基于组合选择 (History_Select_Debtor)”，使用“InvoiceList”引用该特定债务人，总结购买总数并在“txtPurchased”中显示该值。

我需要为每个项目分配一个特定的值，例如“四分之一项目”= 0.25 或“5 项目 = 5”。

例如，如果“Adrian”在 InvoiceList 上记录了 7 笔交易

Added Balance
Quarter Item
Half Item
Quarter Item
10 Items
4 Items
Payed Balance

“txtPurchased”中显示的值为“15”。

我有一个汇总总购买量的宏；

它总结了总行，而不仅仅是在“History_Select_Debtor”中选择了哪个债务人

'-------Total Transactions----------------------------------------------------------------------
Set ws = Worksheets("DebtorList")
    With Me
    'Starting point of lookup data
    Rw = .History_Select_Debtor.ListIndex + 2
    History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
txtTransactions.Value = Application.CountIf(Range("Invoice_list_Debtor"), History_Select_Debtor)
End With
'-----------------------------------------------------------------------------------------------

我制作的另一个宏也不起作用；

=SUM(IF(Invoice_list_Item="Quarter Item",0.25,0)+IF(Invoice_list_Item="Half Item",0.5,0)+IF(Invoice_list_Item="1 Item",1,0)+IF(Invoice_list_Item="2 Items",2,0)+IF(Invoice_list_Item="3 Items",3,0)+IF(Invoice_list_Item="4 Items",4,0)+IF(Invoice_list_Item="5 Items",5,0)+IF(Invoice_list_Item="10 Items",10,0))

这个问题是，鉴于我使用 Invoice_list_Debtor 作为我的 ComboBox 的 RowSource，我最终会得到超过 170 个重复名称。

这是我需要编写代码的页面的源代码；

Public ListTable As Long

Private Sub UserForm_Initialize()

    History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
    History_Select_Debtor = ""

Label6.Visible = False
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Label10.Visible = False
Label11.Visible = False
Label12.Visible = False

Dim ws As Worksheet

Set ws = Worksheets("InvoiceList")
ListTable = ws.Range("A65536").End(xlUp).Row
Me.ListBox1.List = Range("A2:G" & ListTable).Value
Me.ListBox1.Clear
Me.ListBox1.ColumnWidths = "50;80;70;100;80;80;80"

'-----------Listview--------------------------------------------------------------------------------------------------------------
    'Dim ws As Worksheet
    'Dim lngRow As Long
    'Dim lvwItem As ListItem
    'Dim lngEndCol As Long
    'Dim lngCol As Long
    'Dim lngEndRow As Long
    'Dim lngItemIndex As Long
    'Dim blnHeaders() As Boolean
    'Dim Rw As Long

    'Set ws = Worksheets("InvoiceList")
    'lngEndCol = ws.Range("A1").End(xlToRight).Column
    'lngEndRow = ws.Range("A1").End(xlDown).Row
    'ListView1.Gridlines = True
    'lngRow = 1
    'With ListView1

        '.View = lvwReport
        'For lngCol = 1 To lngEndCol
            '.ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Text, ws.Columns(lngCol).ColumnWidth + 59.6
        '.BackColor = vbBlack
        'Next
        'For lngRow = 2 To lngEndRow
            'lngCol = 1
            'lngItemIndex = 0
            'Set lvwItem = .ListItems.Add(, , (ws.Cells(lngRow, lngCol).Text))
            'For lngCol = 2 To lngEndCol
                'lngItemIndex = lngItemIndex + 1
                'lvwItem.SubItems(lngItemIndex) = Format(ws.Cells(lngRow, lngCol).Text, ws.Cells(lngRow, lngCol).NumberFormat) 'Adds Value from Current Row and Column 1
            'Next
        'Next

            '.TextBackground = lvwTransparent

    'End With
'-----------Listview--------------------------------------------------------------------------------------------------------------
'-----------ChartSpace---------------------------------------------------
   Dim ChtSpc As OWC11.ChartSpace
   Dim cht As OWC11.ChChart
   Dim Sps As OWC11.Spreadsheet
   Dim owcChart As OWC11.ChartSpace
   Dim Balance As String

   Balance = Range("B1").Value
   Set owcChart = Me.ChartSpace1
   Set ChtSpc = Me.ChartSpace1
   Set Sps = Me.Spreadsheet1
   Set ws = ThisWorkbook.Worksheets("DebtorList")   ' change to you worksheet name

   Sps.Range("A1:B100") = ws.Range("A1:B100").Value   ' Set worksheet range to sheet control range

   Set ChtSpc.DataSource = Sps   ' set sheet control as chart control source

   Set cht = ChtSpc.Charts.Add  ' Add blank chart

   With cht ' Set data for chart
    .SetData chDimCategories, 0, "A2:A25"    ' change to your category range
    .SeriesCollection(0).SetData chDimValues, 0, "B2:B25" ' change to your series 1 range
    '.PlotArea.FlipHorizontal
    '.PlotArea.FlipVertical
    '.PlotArea.RotateClockwise
    '.SeriesCollection.Add
    '.SeriesCollection(1).SetData chDimValues, 0, "A1:A24" ' change to your series 2 range

    'By changing the layout we can control how the charts are presented
    'inside the Chart space.

   .Interior.Color = RGB(0, 0, 0)
   .Border.Color = vbWhite
   .Border.Weight = Thick

   '.Type = chChartTypeColumn3D
   '.Type = chChartTypeAreaStacked

End With

Me.Spreadsheet1.Visible = False     ' hide the sheet control

'Set up the charts and manipulate some of their properties.

With owcChart.Charts(0)

    'The data reference must be of the datatype string.
    'The last parameter specify if each row represent a serie or not.

    '.HasTitle = True

    With .PlotArea
        .Interior.Color = RGB(0, 0, 0)

        '.Border.Color = RGB(255, 255, 255)
        '.Border.DashStyle = chLineSolid
        '.Border.Weight = Thick
    End With

    'With .Title
        '.Caption = Balance
        '.Font.Name = "Verdana"
        '.Font.Size = 10
        '.Font.Bold = True
        '.Font.Color = RGB(50, 205, 50)
    'End With

    With .Axes(0).Font
        .Name = "Verdana"
        .Size = 8
        '.Bold = True
        .Color = RGB(255, 255, 255)
    End With

    With .Axes(1).Font
        .Name = "Verdana"
        .Size = 8
        '.Bold = True
        .Color = RGB(255, 255, 255)
    End With

    'With .Axes(0).MinorGridlines
        '.Line.Color = RGB(255, 255, 255)
    'End With

    'With .Axes(0).MajorGridlines
        '.Line.Color = RGB(255, 255, 255)
    'End With

    'With .Axes(1).MinorGridlines
        '.Line.Color = RGB(255, 255, 255)
    'End With

    'With .Axes(1).MajorGridlines
            '.Line.Color = RGB(255, 255, 255)
    'End With

    With .SeriesCollection(0)
        '.Border.Color = RGB(255, 255, 255)
        .Interior.Color = vbGreen
        .Caption = Balance
        .Line.Color = RGB(255, 255, 255)
    End With

    'With .SeriesCollection(1)
        '.Interior.Color = vbBlue
        '.Caption = Balance
    'End With

    '.HasLegend = True

    'With .Legend
        '.Position = chLegendPositionBottom
        '.Border.Color = vbWhite
        '.LegendEntries(2).Visible = False
    'End With

End With
'------------------------------------------------------------------------

End Sub


Private Sub cmdClose_History_Click()

  Unload Me
  frmMenu.Show

End Sub

Private Sub History_Select_Debtor_Change()

'--------Total Purchased-----------------------------------------------
    'Worksheets("InvoiceList").Rows(1).AutoFilter Field:=1, Criteria1:="=" & Me.History_Select_Debtor
    'Me.txtPurchased = Worksheets("Summary").[C2] 'the cell containing the SUBTOTAL
'-------------------------------------------------------

Label6.Visible = True
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
Label10.Visible = True
Label11.Visible = True
Label12.Visible = True

FilterList 0, Me.History_Select_Debtor.Text

Me.cmdClose_History.SetFocus

Dim ws As Worksheet
Dim Rw As Long

Set ws = Worksheets("DebtorList")

    'Get row based on ComboBox ListIndex
    With Me
    'Starting point of lookup data
    Rw = .History_Select_Debtor.ListIndex + 2
    'Data to be displayed based on selection
    txtBalance.Value = FormatCurrency(Expression:=ws.Cells(Rw, 2).Value, _
    NumDigitsAfterDecimal:=2)

End With
'-------Total Transactions----------------------------------------------------------------------------------------------------------------------
Set ws = Worksheets("DebtorList")
    With Me
    'Starting point of lookup data
    Rw = .History_Select_Debtor.ListIndex + 2
    History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
txtTransactions.Value = Application.CountIf(Range("Invoice_list_Debtor"), History_Select_Debtor)
End With
'-------Total Payed------------------------------------------------------------------------------------------------------------------------------
txtPayed.Value = FormatCurrency(Expression:=Application.SumIf(Range("Invoice_list_Debtor"), _
History_Select_Debtor.Value, Range("Invoice_list_Price")), _
    NumDigitsAfterDecimal:=2)

End Sub


Private Sub UserForm_QueryClose _
  (Cancel As Integer, CloseMode As Integer)
'   Prevents use of the Close button
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub

Private Sub FilterList(iCtrl As Long, sText As String)
Dim iRow As Long
Dim ws As Worksheet
Dim sCrit As String
sCrit = "*" & UCase(sText) & "*"
Set ws = Worksheets("InvoiceList")
With Me.ListBox1

ListTable = ws.Range("A65536").End(xlUp).Row
.List = ws.Range("A2:G" & ListTable).Value

For iRow = .ListCount - 1 To 0 Step -1
If Not UCase(.List(iRow, iCtrl)) Like sCrit Then
.RemoveItem iRow
End If
Next iRow

        'Determine number of columns
        .ColumnCount = 7
        'Set column widths
        .ColumnWidths = "50;80;70;100;80;80;80"
        'Insert the range of data supplied
        For x = 2 To 3 'loop the numeric columns - 3 to 4
            For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
                .List(i, x) = Format(.List(i, x), "$#,##")
            Next i
        Next x
                For x = 5 To 6 'loop the numeric columns - 4 to 5
            For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
                .List(i, x) = Format(.List(i, x), "$#,##")
            Next i
        Next x
                For x = 4 To 4 'loop the numeric columns - 3 to 4
            For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
                .List(i, x) = Format(.List(i, x), "[$-409]h:mm AM/PM;@")
            Next i
        Next x
End With

End Sub

【问题讨论】：

标签： excel worksheet-function vba

【解决方案1】：

我相信这里不止一个问题......

要获取债务人的发票项目总数，您可以

（自动）过滤当前债务人的 InvoiceList
使用=SUBTOTAL(109,InvoiceSheet!$F:$F) 工作表函数显示发票项目的总和（假设发票表名为[InvoiceSheet] ;-)）

我什至建议将 =SUBTOTAL 放在单独的工作表 (Sheet2) 上，因此它的位置是不变的。不要在对话框中的文本字段上使用ControlSource()，而是设置Locked = True

您可以在 [InvoiceSheet] 上设置一次 Autofilter 并使用 Sub

Private Sub History_Select_Debtor_Change()
    Worksheets("InvoiceSheet").Rows(1).AutoFilter field:=1, Criteria1:="=" & Me.History_Select_Debtor
    Me.txtPurchased = Worksheets("Sheet2").[A1] 'the cell containing the SUBTOTAL
End Sub

触发过滤器并将 SUBTOTAL 公式的值返回到对话框中。

对于从文本到数字的数量转换，我建议创建一个额外的表 [QTYCode]，看起来像

         A        B    ...
  +------------+-----+----
1 |Text        |Value|
2 |Quarter item| 0.25|
3 |Half item   |  0.5|
4 |1 item      |    1|
5 |2 item      |    2|
6 |3 item      |    3|
...

其中 A 列（标题行除外）用作 QTY 选择框的 RowSource()，对于您在 [InvoiceSheet] 中创建的每条记录，您不仅保存选定的 QTYText，还保存一个包含 =VLOOKUP 的额外列() 将文本转换为值的公式（当然，您的 =SUBTOTAL() 基于该新列）

希望有帮助

祝你好运 - MikeD

【讨论】：

感谢堆麦克工作得很好，我按照您的建议和使用制作了 ItmCode 表；
Sheets("Summary").Range("C2").Value = Application.WorksheetFunction.Subtotal(109, Range("InvoiceList_ItmCode")) 但是当我遇到自动筛选问题时我在我的列表视图中查看 InvoiceList，它现在不显示新记录；在 InvoiceList 上的列“I”中，我在 InvoiceList 上的每个项目旁边添加了带有代码的 ItmCode 列，并在购买源 Dim QtyCode As Variant QtyCode = Application.WorksheetFunction.VLookup(Purchase_Select_Quantity.Value, Range(" PriceList_Quantity_Table"), 2, False) 我遇到的问题是当我进行新购买时，它会删除行
就像使用自动过滤器设置时，当我购买时它无法将新的发票记录放置在正确的位置，现在我有了 ItmCode 列和 ItmCode 表，我可以使用另一种方法而不是比自动过滤？
漂亮，已修复，非常感谢您的帮助 Mike，我用来修复它的代码； Me.txtPurchased = Application.SumIf(Range("InvoiceList_Table_ItmCode"), Me.History_Select_Debtor.Value, Range("InvoiceList_ItmCode"))
确保在定义自动过滤器时选择完整的行（要求标题行是第 1 行） - 插入新记录必须在自动过滤器设置为“显示所有数据”的情况下完成。我建议您在选择框的“更改”触发器上将 AutoFilter ON 切换到当前参数，并在表单失去焦点时和插入记录之前将其设置为“显示所有数据”。还有更多....只需发布（此处为欧洲时区:-)）