生成一串无重复的组合词

Question

我有一张桌子，上面有一些美味的水果:)但是一个水果可以在那张桌子上出现多次，例如：

水果	y
苹果	1
香蕉	2
香蕉	3
草莓	4

最终，该表可以有最多 10 行的不同水果，因此

y

可以具有来自

1 to 10

的值。我现在正在努力的是生成该格式的字符串：

苹果+香蕉x2+草莓

所以我想要每个水果都串一次。当水果出现多次时，我想要在水果旁边显示“xAmount”。 但用我的代码，它会生成这个字符串：

苹果+香蕉x2+香蕉+草莓

根据水果的位置和重复的数量，不会生成我需要的字符串...

这是我的代码：

Dim y As Integer    
Dim Counter1 As Integer
Dim Counter2 As Integer
Dim NewBufferCounter As Integer
Dim a As Integer
Dim ArrayBuffer1(15) As String
Dim NewBuffer(15) As String
Dim FinalString(15) As String
Counter1 = 0
Counter2 = 0
a = 1

'2 nested FOR-Loops to compare the fruits for duplicates
For Counter1 = 0 To (y - 1)
        a = 1
                                     
        For Counter2 = Counter1 + 1 To (y - 1)
                    
                    If (ArrayBuffer1(Counter1) = ArrayBuffer1(Counter2)) And (ArrayBuffer1(Counter1) <> "") And (Counter1 <> Counter2) Then
                    a = a + 1
                    NewBuffer(NewBufferCounter) = ArrayBuffer1(Counter1) & " x" & a                 
                    
                    ElseIf (a = 1) And (ArrayBuffer1(Counter1) <> "") Then
                    NewBuffer(NewBufferCounter) = ArrayBuffer1(Counter1)
                    
                    Else
                    'Do nothing
                    End If
                    
                    If Counter2 = (y - 1) Then
                    NewBufferCounter = NewBufferCounter + 1
                    Else
                    'Do nothing
                    End If
                    
          Next Counter2
                
Next Counter1

'Further IF-Statement because the second FOR-Loop will skipped when "y" equals "1"           
If y = 1 Then
NewBuffer(NewBufferCounter) = ArrayBuffer1(0)
End If


AmountDiffFruits = NewBufferCounter



'Generate the final string I need
  For NewBufferCounter = 0 To AmountDiffFruits
               If (NewBuffer(NewBufferCounter) <> "") Then
                            If (IsEmpty(FinalString(NewBufferCounter))) Then
                            FinalString(0) = NewBuffer(NewBufferCounter)
                            
                            Else
                            FinalString(0) = FinalString(0) & " + " & NewBuffer(NewBufferCounter)
                        
                            End If
              Else
              'Do nothing
              End If
                   
     Next NewBufferCounter
                                    
Erase ArrayBuffer1()
Erase NewBuffer()
Erase FinalString()
NewBufferCounter = 0

希望有人能解决这个问题...谢谢！

Answer 1

我建议使用字典

Dim i As Integer
Dim fruit As String
Dim fruitCount As Object
Set fruitCount = CreateObject("Scripting.Dictionary")

' Sample data input
Dim fruits() As String
fruits = Array("Apple", "Banana", "Banana", "Strawberry")

' Count each fruit occurrence
For i = LBound(fruits) To UBound(fruits)
    fruit = fruits(i)
    If fruitCount.Exists(fruit) Then
        fruitCount(fruit) = fruitCount(fruit) + 1
    Else
        fruitCount.Add(fruit, 1)
    End If
Next i

' Building the final string
Dim result As String
result = ""

For Each fruit In fruitCount.Keys
    If fruitCount(fruit) > 1 Then
        result = result & fruit & " x" & fruitCount(fruit) & " + "
    Else
        result = result & fruit & " + "
    End If
Next fruit

' Remove the trailing " + "
If Len(result) > 0 Then
    result = Left(result, Len(result) - 3)
End If

' Output the result
Debug.Print result