Код VBA: подсчитать ячейки с одинаковым значением, затем добавить формулу в диаграмму - PullRequest
0 голосов
/ 19 марта 2019

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

Я просмотрел несколько макросов и попытался записать процесс, который я выполняю (используя сводную таблицу), но все еще могуне повезло.Я не очень хорошо разбираюсь в кодировании, но ценю любую помощь от вас.Спасибо!

Я создал код, как показано ниже, изменив макрос, который искал в сети.Однако он учитывает даже те строки, которые были скрыты после фильтрации.Кроме того, я не могу вывести его в виде диаграммы.

Пример таблицы: образец

Dim cell As Range
Dim mess As String
Dim rngcheck As Range
Dim rng1 As Range
Dim E As Range
Dim objDic
Dim i As Variant
Dim pcs As Variant
Dim p As Variant
Dim u As Single

'Dim strMsg As String

Set objDic = CreateObject("scripting.dictionary")
Set rng1 = Range([E1], Cells(Rows.Count, "E").End(xlUp))
u = 0
For Each E In rng1
    If Len(E.Value) > 0 Then
        If Not objDic.exists(E.Value) Then
            objDic.Add E.Value, CStr(E.Address)
            'u = u + 1
        Else
            objDic(E.Value) = objDic(E.Value) & ", " & CStr(E.Address)
        End If
    End If
Next

Dim comma As String, strMsg As String
'
strMsg = ""
For Each i In objDic.Keys
    pcs = Split(objDic(i), ",")
    If UBound(pcs) > 1 Then
        u = (UBound(pcs) + 1) * 5 / 60
'        MsgBox i & " = " & UBound(pcs) + 1 & " hrs: " & u
        strMsg = strMsg & i & " = " & UBound(pcs) + 1 & " hrs: " & u
        comma = ""
        For Each p In pcs
                strMsg = strMsg & comma '& p
                'comma = ", "
        Next

        strMsg = strMsg & vbNewLine
    End If

Next
'
If Len(strMsg) > 0 Then MsgBox strMsg

Теперь у меня проблема с SOrting только определенных ячеек.

With Sheets("DT_Status" & u)
    .Select
    .Sort.SortFields.Add Key:=Sheets("DT_Status" & u).Range(Cells(StartFilt, 1), Cells(EndFilt, 3)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    '.Sort.SetRange Sheets("DT_Status" & u).Range(Cells(StartFilt, 1), Cells(EndFilt, 3))
    .Sort.Apply
    .Shapes.AddChart.Select
    '.ChartObject.Name = "Chart_" & Sheets("Summary").Range("H" & x).Value
End With

Ошибка «1004»: «Недопустимая ссылка на сортировку».

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...