Добавить общее количество одинаковых значений в массиве
У меня есть столбец текстовых значений. Значение может встречаться более одного раза. Я хочу изменить значения так, чтобы вхождения одного и того же значения были (разборчиво) пронумерованы. Я добавил ввод и желаемый результат, чтобы прояснить это.
Не могу понять, как добавить сумму к каждому похожему значению в массиве, я действительно могу подсчитать похожие значения, чтобы получить сумму, так как я сравниваю значения массива, но как вернуться к значениям и добавить сумму, как показано в желаемом выходе
Чтобы быть более ясным, он также должен подсчитывать только последовательные похожие значения, если аналогичные значения появляются позже в списке, он должен просто иметь свой собственный счет в добавленной сумме.
это мой вклад
Это мой желаемый результат
Это мой код:
Sub groupindexcells()
Dim arr As Variant
Dim rlast As Long, i As Long, rsum As Long
Dim comparevalue
rlast = Sheet1.Cells(Rows.count, "A").End(xlUp).Row
arr = Sheet1.Range("A2:A" & rlast).Value
rsum = 1
For i = 1 To UBound(arr) - 1
If comparevalue = "" Then
If arr(i, 1) = arr(i + 1, 1) Then
arr(i, 1) = arr(i, 1) & "-" & rsum
rsum = rsum + 1
Else
arr(i, 1) = arr(i, 1) & "-" & rsum
comparevalue = arr(i + 1, 1)
rsum = 1
End If
Else
If arr(i, 1) = comparevalue Then
If arr(i, 1) = arr(i + 1, 1) Then
arr(i, 1) = arr(i, 1) & "-" & rsum
rsum = rsum + 1
Else
comparevalue = arr(i + 1, 1)
arr(i, 1) = arr(i, 1) & "-" & rsum
rsum = 1
End If
End If
End If
Next i
'append the index for the last row
If arr(UBound(arr), 1) = comparevalue Then
arr(UBound(arr), 1) = arr(UBound(arr), 1) & "-" & rsum
Else
arr(UBound(arr), 1) = arr(UBound(arr), 1) & "-" & 1
End If
Sheet1.Range("A2:A" & rlast).Value = arr
End Sub
А это текущий выход
@Storax yes, чтобы изменить код, чтобы добавить общее количество тех же значений, что и в желаемом выводе.
С какой конкретной проблемой вы столкнулись при попытке?
@braX я действительно могу получить общее количество похожих значений, так как я сравниваю значения массива, но как вернуться к каждому значению массива и добавить сумму?
Ответы 1
Обновлено для подсчета только последовательных похожих значений.
Я добавил переменные NewValue и EachTotal.
Sub groupindexcells()
Dim arr As Variant
Dim rlast As Long, i As Long, rsum As Long
Dim comparevalue
Dim NewValue As Boolean
Dim EachTotal As Long
rlast = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
arr = Sheet1.Range("A2:A" & rlast).Value
rsum = 1
NewValue = True
EachTotal = 0
For i = 1 To UBound(arr) - 1
If comparevalue = "" Then
If NewValue = True Then
j = i
Do While arr(i, 1) = arr(j, 1)
EachTotal = EachTotal + 1
j = j + 1
If j > UBound(arr) Then Exit Do
Loop
End If
If arr(i, 1) = arr(i + 1, 1) Then
NewValue = False
arr(i, 1) = arr(i, 1) & "-" & rsum & " of " & EachTotal
rsum = rsum + 1
Else
arr(i, 1) = arr(i, 1) & "-" & rsum & " of " & EachTotal
comparevalue = arr(i + 1, 1)
rsum = 1
NewValue = True
EachTotal = 0
End If
Else
If NewValue = True Then
'new
j = i
Do While arr(i, 1) = arr(j, 1)
EachTotal = EachTotal + 1
j = j + 1
If j > UBound(arr) Then Exit Do
Loop
End If
If arr(i, 1) = comparevalue Then
If arr(i, 1) = arr(i + 1, 1) Then
NewValue = False
arr(i, 1) = arr(i, 1) & "-" & rsum & " of " & EachTotal
rsum = rsum + 1
Else
comparevalue = arr(i + 1, 1)
arr(i, 1) = arr(i, 1) & "-" & rsum & " of " & EachTotal
rsum = 1
NewValue = True
EachTotal = 0
End If
End If
End If
Next i
'append the index for the last row
If arr(UBound(arr), 1) = comparevalue Then
arr(UBound(arr), 1) = arr(UBound(arr), 1) & "-" & rsum & " of " & EachTotal
Else
arr(UBound(arr), 1) = arr(UBound(arr), 1) & "-" & 1
End If
Sheet1.Range("A2:A" & rlast).Value = arr
End Sub
спасибо за код, мой плохой, я не понял, но он должен подсчитывать только последовательные похожие значения, если те же значения появляются позже в списке, они должны иметь другое количество и сумму
Обновленный ответ выше
Не вижу вопроса в посте. Итак, в чем вопрос? Или вы хотите, чтобы мы полностью изменили код для вас так, чтобы вы получили желаемый результат?