根据选择搜索和求和

时间:2010-10-18 15:15:56

标签: excel excel-vba worksheet-function vba

我尝试了Sum,CountIf,Dsum,SumProduct

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

UserForm还有一个购买总项目的文本框,名为“txtPurchased”。

对于每个事务,记录保存在工作表“InvoiceList”上,该列表由7列组成。

这些列中的每一列都具有动态命名范围

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)

项目栏中保存的记录是文本;

“支付余额”,“增加余额”,“季度项目”,“半项目”,“1项目” - “10项”

我需要,“基于组合选择(History_Select_Debtor)”,参考具有“InvoiceList”的Particilar Debtor,总计购买总数并在“txtPurchased”中显示该值。

我需要为每个项目分配一个特定值,例如“Quarter Item”= 0.25或“5 Item = 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

1 个答案:

答案 0 :(得分:2)

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

要获得债务人的发票项目总数,您可以

  1. (自动)过滤当前债务人的InvoiceList
  2. 使用=SUBTOTAL(109,InvoiceSheet!$F:$F)工作表功能显示已开票项目的总和(假设发票表名为[InvoiceSheet] ;-))
  3. 我甚至建议在单独的工作表(Sheet2)上使用= SUBTOTAL,因此它的位置是不变的。不要在对话框的文本字段中使用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