Найти наибольшее значение на основе двух критериев, а затем записать в ячейку

Question

У меня большой счет csv / excel (UPS - не уверен, что это будет иметь значение). Я проверяю и назначаю недостающие центры затрат каждую неделю и использую VBA для автоматизации этого процесса. (И медленно учить себя программированию) Обычно это не сложнее, чем, если x это ячейка, а затем использовать y центр затрат, и я смог написать простой FOR, IF, InStr и другой код для этого. Но я наткнулся на шаг, который выходит за рамки моих текущих навыков.

Вот проблема:

Мы используем консолидированный счет, который содержит много разных счетов. Иногда со счета взимается плата за обслуживание. Если это так, то эта плата за обслуживание применяется к учетному центру под учетной записью, для которой была установлена ​​наибольшая сумма. Я приведу упрощенный пример.

Мы начнем с этого:

Поскольку D8 говорит: «Плата за обслуживание«Мне нужно B8, чтобы центр затрат был равен наибольшему количеству сборов. В случае Account1 стоимость CostCenter1 составляет 17,00 долларов США. Для Account2 это будет CostCenter3. В конце концов, конечный продукт должен выглядеть следующим образом:

Мы ценим любое руководство по этому вопросу. Я хотел бы показать код, но я действительно не знаю, с чего начать.

Answer 1

Для формулы в приложении к ячейке:

=INDEX(A:C,MATCH(MAXIFS(C:C,A:A,"="& A8,C:C,"<>"&C8),C:C),2)

Просто замените A8 / C8 на строку, в которую она помещается, или вставьте ее в B8, а затем скопируйте / вставьте ячейку в другие строки. это быстрое решение без программирования, просто используя встроенную функциональность Excel.

Answer 2

Я написал пользовательскую функцию, которая возвращает необходимый вам CostCenter:

Public Function MaxCC()

Dim strAcc As String, strCC As String, dblChg As Double, lastrow As Long

strAcc = Application.Caller.Offset(, -1).Value2
lastrow = Application.Caller.Worksheet.Cells(Rows.Count, 1).End(xlUp).Row

Dim dictCC As New Scripting.Dictionary

Dim i As Long
For i = 2 To lastrow
    If Application.Caller.Worksheet.Cells(i, 1).Value2 = strAcc Then
        If i <> Application.Caller.Row Then strCC = Application.Caller.Worksheet.Cells(i, 2).Value2
        dblChg = Application.Caller.Worksheet.Cells(i, 3).Value2

        If Not dictCC.Exists(strCC) Then dictCC.Add strCC, 0

        dictCC(strCC) = dictCC(strCC) + dblChg
    End If
Next i

Dim strMaxCC As String, dblMaxCC As Double, varKey As Variant
dblMaxCC = 0
For Each varKey In dictCC.Keys
    If dictCC(varKey) > dblMaxCC Then
        strMaxCC = CStr(varKey)
        dblMaxCC = dictCC(varKey)
    End If
Next varKey

MaxCC = strMaxCC

End Function

Эта функция использует словарь, просто обязательно укажите Microsoft Scripting Runtime, как описано здесь .

Вы сможете ввести =MaxCC() в качестве формулы в пустые ячейки, которые вам нужно заполнить, и он предоставит вам правильный CostCenter. Дайте мне знать, если это работает для вас, и если у вас есть дополнительные вопросы.

Answer 3

В этом решении используется класс, я использовал позднюю привязку к словарям, если вы хотите раннюю привязку, добавьте ссылку и set variable = New Dictionary

Код класса:

Option Explicit

Private pCenterdict As Object

Public Sub Load_Data(center As String, cost As Double)
    If Not pCenterdict.Exists(center) Then
        pCenterdict.Add center, cost
    Else
        pCenterdict(center) = pCenterdict(center) + cost
    End If
End Sub

Public Sub initialize()
    Set pCenterdict = CreateObject("Scripting.Dictionary")
End Sub

Public Function return_highest() As String
    Dim key As Variant
    Dim highestkey As String
    Dim highestval As Double

    highestval = 0
    For Each key In pCenterdict.Keys()
        If pCenterdict(key) > highestval Then
            highestval = pCenterdict(key)
            highestkey = key
        End If
    Next key
    return_highest = highestkey
End Function

Основной код:

Sub test()
    Dim lr As Long
    Dim i As Long

    Dim clsdict As Object
    Dim clsobj As Object

    Set clsdict = CreateObject("Scripting.Dictionary")

    With ActiveWorkbook.Sheets("Sheet1") ' Change this to whatever the sheet name is
    lr = .Cells(.rows.count, 1).End(xlUp).row

    For i = 2 To lr
        If Not .Cells(i, 4).value = "Service Fee" Then
            If Not clsdict.Exists(.Cells(i, 1).value) Then
                Set clsobj = New Cls_SO 'Create instance, If you name your class something else change this to New YourClassNameHere
                clsobj.initialize 'Create Dictionary
                clsobj.Load_Data .Cells(i, 2).value, .Cells(i, 3).value 'Load Values
                clsdict.Add .Cells(i, 1).value, clsobj
            Else
                clsdict(.Cells(i, 1).value).Load_Data .Cells(i, 2).value, .Cells(i, 3).value 'Load Values
            End If
        Else
            .Cells(i, 2).value = clsdict(.Cells(i, 1).value).return_highest 'Get Highest
        End If
    Next
    End With



End Sub

Answer 4

 function max2(arr,i) as double
  dim max as double 
  max=arr(i,0);
  for j=0 to ubound(arr,2)
    if arr(i,j)>max then max=arr(i,j)
   next
    max2=max
 end sub 

 sub test

  'build some kind of array structure for your pricing mess

  dim cc() as double
  redim cc(2,3)


   'just fill the structure somehow
   cc(0,0)=1'cc=cost center
   cc(0,1)=2
   cc(0,2)=3

   cc(1,0)=5
   cc(1,1)=1
   cc(1,2)=7

   'get the maximum profit to be able to buy a new Porsche      

  debug.print max2(cc,0)  

  debug.print max2(cc,1)

 'if we need a Ferrari

  result=max2(cc,0)  
  if max2(cc,1) > result then result =max2(cc,1)

  ' or just add a modified max sub with just one dimension
  'or fill a virtual cost center array with the results so far... and run the 
  'max2 fucntion on that  

end sub