Excel macro - обработка данных

Question

Я новичок в макросах, и мне нужна помощь для ниже.

Я имеют значения, как указано выше. Я хочу подсчитать общее количество яблок, апельсинов и т. Д. Я хочу конечный результат в другом листе как ниже яблок = 15 Banana = 17 Mangoes = 15 Апельсины = 13 дыни = 7

Я понимаю, что нужно сначала разделить их и хранить их в массиве и петли для подсчета их. Но я не уверен, как это сделать. Пожалуйста помоги! Спасибо!

Answer 1

Public Function ConcatResults(rng As Range) As String 
Dim rng1 As Range, tmpArray() As String, nameArray() As String, sumArray() As Double, counter As Long 
For Each rng1 In rng 'for each cell in your range 
    If InStr(rng1.Value2, "=") > 0 Then 'if it contains an equal sign 
     tmpArray = Split(rng1.Value2, "=") 'the cell value gets split by the equal sign 
     If NameIndex(tmpArray(0), nameArray) > -1 Then 'if the fruit name is found already in the name array 
      sumArray(NameIndex(tmpArray(0), nameArray)) = sumArray(NameIndex(tmpArray(0), nameArray)) + CDbl(tmpArray(1)) 'then it adds the number to the existing name's corresponding sum 
     Else 'otherwise 
      ReDim Preserve nameArray(counter) 'it expands the array of fruit names 
      ReDim Preserve sumArray(counter) 'and the corresponding sum array 
      nameArray(counter) = tmpArray(0) 'adds the name to the last (open) place in the name array 
      sumArray(counter) = CDbl(tmpArray(1)) 'adds the name to the last (open) place in the sum array 
      counter = counter + 1 'increments the index for further potential list items 
     End If 
    End If 
Next rng1 
'exports data 
For i = LBound(nameArray) To UBound(nameArray) 'for the whole set 
    ConcatResults = ConcatResults & nameArray(i) & " = " & sumArray(i) & " " 'it concatenates [NAME] = [SUM] 
Next i 

ConcatResults = Left(ConcatResults, Len(ConcatResults) - 1) 'removes the ending space 

End Function 
Function NameIndex(str As String, arr() As String) As Long 'this function tells the index of the given string (fruit) in the [name]array 
'defaults to -1 
NameIndex = -1 
On Error GoTo err 'if the array is not yet defined it outputs the default -1 
For i = LBound(arr) To UBound(arr) 'for each item in the set 
    If arr(i) = str Then NameIndex = i 'if it's the same as the item we're looking for then outputs its index 
Next i 
err: 
End Function 

Выход Apples = 15 Oranges = 13 Mangoes = 15 Banana = 12 Bananas = 5 Melon = 7, обратите внимание, Бананы = 5 происходит из-за опечатки в описании.

Answer 2

ОБНОВЛЕН С FIX К выходу за пределы и подобрать АНОМАЛИИ +/- «s»

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

Sub test() 

Dim arr As Variant 
Dim n, Apples, Oranges, Banana, Mangoes, Melon As Integer 

Apples = 0 
Oranges = 0 
Banana = 0 
Mangoes = 0 
Melon = 0 

n = 0 
For Each Cell In Sheets(1).UsedRange.Cells 
    If IsEmpty(Cell) Then GoTo 0 

    arr = Split(Cell, "=") 

    If Left(arr(0), 5) = "Apple" Then 
    Apples = Apples + arr(1) 
    End If 

    If Left(arr(0), 6) = "Orange" Then 
    Oranges = Oranges + arr(1) 
    End If 

    If Left(arr(0), 6) = "Banana" Then 
    Banana = Banana + arr(1) 
    End If 

    If Left(arr(0), 5) = "Mango" Then 
    Mangoes = Mangoes + arr(1) 
    End If 

    If Left(arr(0), 5) = "Melon" Then 
    Melon = Melon + arr(1) 
    End If 

0 
Next 

Sheets(2).Cells(1, 2).Value = Apples 
Sheets(2).Cells(2, 2).Value = Oranges 
Sheets(2).Cells(3, 2).Value = Banana 
Sheets(2).Cells(4, 2).Value = Mangoes 
Sheets(2).Cells(5, 2).Value = Melon 

End Sub