Поиск и сумма на основе выбора - PullRequest
2 голосов
/ 18 октября 2010

Я пробовал Sum, CountIf, Dsum, SumProduct

У меня есть пользовательская форма с ComboBox "History_Select_Debtor".RowSource для ComboBox - «Debtor_list_Debtors» - динамический именованный диапазон на рабочем листе «DebtorList».Он состоит из имен клиентов из A2: A24, но со временем будет расти.

У пользовательской формы также есть текстовое поле для общего количества приобретенных товаров с именем «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 предметов»

Мне нужно, «на основе комбо»selection (History_Select_Debtor) ", Ссылка на этого частичного должника с помощью" InvoiceList ", суммирует общее количество покупок и отображает это значение в" txtPurchased ".

Мне нужно, чтобы каждому элементу было присвоено определенное значение, например, «Квартальный элемент» = 0,25 или «5 элемент = 5».

Если в качестве примера «Адриан» имеет 7 транзакций, зарегистрированных наInvoiceList

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

Значение, отображаемое в «txtPurchased», будет «15».

У меня есть макрос, который суммирует общее количество покупок;

Itсуммирует итоговую строку, а не просто того, какой должник выбран в "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 в качестве RowSource для моего ComboBox, я получаю более 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 Ответ

2 голосов
/ 18 октября 2010

Здесь, по-моему, существует более одной проблемы ...

Чтобы получить общее количество счетов-фактур для должника, вы можете

  1. (авто) отфильтровать InvoiceList дляВаш текущий Должник
  2. отображает сумму счетов-фактур, используя функцию листа =SUBTOTAL(109,InvoiceSheet!$F:$F) (при условии, что лист счета-фактуры имеет имя [InvoiceSheet] ;-))

Я бы даже предложилиметь это = SUBTOTAL на отдельном листе (Sheet2), поэтому его местоположение является постоянным.Не используйте ControlSource() для текстового поля в диалоговом окне, но установите Locked = True

. Вы можете настроить автофильтр на [InvoiceSheet] один раз и использовать 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 (кроме строки заголовка) служит в качестве RowSource () для поля выбора QTY, и для каждой записи, которую вы создаете в [InvoiceSheet], вы сохраняете не только выбранный QTYText, но также и дополнительный столбец, содержащий = VLOOKUP() формула, которая преобразует текст в значение (и основывает ваш = SUBTOTAL () на этом новом столбце - конечно)

Надеюсь, что поможет

Удачи - MikeD

...