Могу ли я сделать промежуточный макрос более эффективным?

Question

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

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

Неисправность в том, что она требует возраста для запуска из-за суммы на данные.

Есть ли другой способ обойти это, чего я не вижу? Я вставил свой текущий код ниже. ТИА

' Add Totals 

Sheets("Data").Select 
Columns("G:G").Select 
Selection.NumberFormat = "mm" 
Range("F4").Select 
Selection.Subtotal GroupBy:=7, Function:=xlCount, TotalList:=Array(7), _ 
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True 
ActiveSheet.Outline.ShowLevels RowLevels:=2 
Range("G3:G4000").Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
Selection.Copy 
Sheets("Set Up Data").Select 
Range("B2").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
Sheets("Data").Select 
Range("D56").Select 
Application.CutCopyMode = False 
Selection.RemoveSubtotal 

Answer 1

Есть 2 других способов я могу думать, но и покажет ответы в другой таблице:

1. Использование сводной таблицы
2. Использование PowerQuery - это теперь встроен в Excel 2016, но является бесплатным добавлением Microsoft для 2010/2013.

Answer 2

Немного хакки, но должно быть быстрее, чем у вас. Я предполагаю, что вы знаете минимальную дату и максимальную дату.

Вы начинаете с добавления нового столбца, который объединяет месяц и год. Например, для 24 января 2016 года значение столбца будет в январе2016. Вы прокручиваете лист, чтобы добавить этот столбец для каждой строки. Теперь вы делаете второй цикл и этот цикл времени между датами между начальным месяцем и конечным месяцем, а в цикле вы подсчитываете количество вхождений каждой конкатенированной строки в столбец листа месяца-годов. Итак, если первый месяц - февраль 2015 года, вы подсчитываете количество вхождений февраля2015 в столбец, а затем следующую итерацию, вы считаете число марта2015 и так далее. В конце у вас есть счет за месяц, и вы удаляете дополнительную колонку.

Answer 3

Скорее всего скопировать данные в массив вариантов и провести анализ на этом.

Что-то вроде этого

Sub Demo() 
    Dim rData As Range 
    Dim vData As Variant 
    Dim i As Long 
    Dim Counts(1 To 12, 1 To 1) As Long 

    ' Get range reference to source data 
    ' assumes data is in column G, starting at row 4. Adjust as required 
    With Worksheets("Data") 
     Set rData = .Range(.Cells(4, 7), .Cells(.Rows.Count, 7).End(xlUp)) 
    End With 

    ' copy range data to variant array 
    vData = rData.Value 

    ' count occurance of each month 
    For i = 1 To UBound(vData, 1) 
     ' allow for possibility that dates are actually strings 
     Counts(Month(CDate(vData(i, 1))), 1) = Counts(Month(CDate(vData(i, 1))), 1) + 1 

    Next 

    ' put count data back on sheet 
    ' adjust target as required 
    Worksheets("Set Up Data").Cells(2, 2).Resize(UBound(Counts, 1), 1) = Counts 

End Sub 

Answer 4

Пожалуйста, вы можете попробовать следующий код? Я только что изменил некоторые вещи из того, что вы опубликовали. Данные должны быть отсортированы по дате присоединения для его работы.

Sub testSubtotal() 
    Sheets("Data").Select 
    Columns("G:G").Select 
    ' Since you have two different years in the example I think it would be 
    ' better to get subtotals for year and month together 
    Selection.NumberFormat = "yyyy-mm" 
    Range("F1").Select 
    Selection.Subtotal GroupBy:=7, Function:=xlCount, TotalList:=Array(7), _ 
     Replace:=True, PageBreaks:=False, SummaryBelowData:=True 
    ActiveSheet.Outline.ShowLevels RowLevels:=2 

    ' Selecting also column F you will get the description of the subtotal 
    ' in the "Set Up Data" worksheet 
    Range("F1:G4000").Select 
    Selection.SpecialCells(xlCellTypeVisible).Copy 
    Sheets("Set Up Data").Select 

    ' I have changed the destination cell to B1 
    ' but I do not know how yor worksheet is formatted. 
    Range("B1").Select 
    ActiveSheet.Paste 
    Sheets("Data").Select 
    Cells.Select 
    Selection.RemoveSubtotal 
End Sub 

Я тестировал его только на столе с небольшим количеством данных, но он не кажется медленным. Я просто надеюсь, что я правильно понял ваш вопрос ...

Answer 5

Вы всегда могли бы пойти метод формулы:

С помощью таблицы, созданной я использовал СЧЕТЕЛИ() формулу:

=COUNTIFS(G:G,"<"&DATE(K2,J2+1,1),G:G,">=" &DATE(K2,J2,1)) 

Или вы могли бы использовать SUMPRODUCT():

=SUMPRODUCT((G:G<DATE(K2,J2+1,1))*(G:G>=DATE(K2,J2,1))) 

Это это просто FYI.