Я боролся с моим отчетом Excel, пытаясь свернуть дублирующиеся строки на основе двух значений столбца. Также необходимо рассчитать сумму 3-го и 4-го столбца и рассчитать процент.
Вот данные
a1 b1 c1 d1 e1
disc1 song1234 3 20 15%
disc2 song78 2 30 7%
disc1 song54 1 10 10%
disc3 song4 4 10 40%
disc4 song0 1 15 7%
disc2 song78 2 16 13%
disc1 song1234 0 19 0%
disc4 song9 1 20 5%
disc1 song1234 0 10 0%
вот что я пробовал до сих пор:
Public Sub duplicateRollUp()
Application.ScreenUpdating = False '
Dim SUMcols() '### declare a second empty array for our sum columns
Dim AVtemp() '### declare a third empty array for our temp values we need to calculate %
SUMcols() = Array(3, 4) '### the second array stores the columns which should be summed up
Sheets("test").Select
Dim LLoop As Integer
Dim LTestLoop As Integer
Dim LClearRange As String
Dim Lrows As Integer
Dim LRange As String
'Column A values
Dim LChangedValue As String
Dim LTestValue As String
'Column B values
Dim LChangedValueB As String
Dim LTestValueB As String
'Test first 1000 rows in spreadsheet for uniqueness
Lrows = 1000
LLoop = 2
'Clear all flags
LClearRange = "A13:B" & Lrows
Range(LClearRange).Interior.ColorIndex = xlNone
'Check first 1000 rows in spreadsheet
While LLoop <= Lrows
LChangedValue = "A" & CStr(LLoop)
LChangedValueB = "B" & CStr(LLoop)
If Len(Range(LChangedValue).Value) > 0 Then
'Test each value for dups
LTestLoop = 2
While LTestLoop <= Lrows
If LLoop <> LTestLoop Then
LTestValue = "A" & CStr(LTestLoop)
LTestValueB = "B" & CStr(LTestLoop)
'Value has been duplicated in another cell
If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then
'Set the background color to yellow in column A
Range(LChangedValue).Interior.ColorIndex = 6
Range(LTestValue).Interior.ColorIndex = 6
'Set the background color to yellow in column B
Range(LChangedValueB).Interior.ColorIndex = 6
Range(LTestValueB).Interior.ColorIndex = 6
End If
End If
LTestLoop = LTestLoop + 1
Wend
End If
LLoop = LLoop + 1
Wend
Application.ScreenUpdating = True '### re-enable our screen updating
End Sub '### ends our macro