Извлекайте уникальные месяцы из дат с годом

Question

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

   Date      Sales
--------------------
07-09-2018   $3,000 
08-09-2018   $2,500 
09-10-2018   $2,800 
10-10-2018   $2,700 
11-11-2018   $2,500 
12-12-2018   $3,200 
13-12-2018   $2,900 
14-08-2018   $2,750 
15-08-2018   $2,875 

Сейчас я использую вспомогательный столбец и комбинацию формул для извлечения уникальных месяцев. Я также могу сделать это с Pivot Table. Но мне нужен некоторый анализ этих данных, потому что в моих реальных данных много столбцов, и мне нужно несколько других отчетов. Так что, если кто-нибудь может помочь мне сделать это без вспомогательного столбца и Pivot Table. UDF - второй вариант, если это невозможно с помощью встроенных функций.

Answer 1

В этом примере я использую Sheet1, а результаты вставляем в Sheet2

.

Попытка:

Public Sub Get_Unique_Count_Paste_Array()

Dim Ob As Object
Dim rng As Range
Dim Item As Variant
Dim str As String
Dim r As Long
Dim Date_ As String
Dim Amount_ As Double

r = 1

Set Ob = CreateObject("scripting.dictionary")


LR = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row

For Each rng In Sheet1.Range("A2:A" & LR)
    Date_ = Format(rng.Value, "mmm-yy")
    Amount_ = Right(rng.Offset(0, 1).Value, Len(rng.Offset(0, 1).Value) - 1)

    If Len(Date_) > 0 Then
        str = Date_
        Ob(Date_) = Ob(Date_) + Amount_
    End If
Next rng

For Each Item In Ob.keys

    With Worksheets("Sheet2")

        .Cells(r, 1).Value = Item
        With .Cells(r, 2)
            .Value = Ob(Item)
            .NumberFormat = "[$$-en-US]#,##0.00"
        End With

    End With

    r = r + 1

Next Item

End Sub

Answer 2

Monthify

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

Option Explicit

Sub Monthify()

'**** Customize BEGIN ******************
  Const cStrDateCol As String = "B"     ' Column Letter of the Date
  Const cStrSalesCol As String = "C"    ' Column Letter of the Sales
  Const cStrMonthCol As String = "E"    ' Column Letter of the Resulting Month
  Const cStrTotalCol As String = "F"    ' Column Letter of the Resulting Sales
  Const cLngFirstRow As Long = 4        ' First Row of Initial Data
  Const cLngFirstRowResult As Long = 4  ' First Row of Resulting Data
  Const cLngLastRow As Long = 0         ' Last Row (If 0, it is calculated.)
  Const cStrSheet = "Sheet1"            ' Sheet Name. If "", then ActiveSheet.
  Const cStrMonth1 As String = "MMM"    ' Month Format Part 1
  Const cStrMonth2 As String = "-"      ' Month Format Part 2
  Const cStrMonth3 As String = "YY"     ' Month Format Part 3
'**** Customize END ********************

  Dim objWs As Worksheet

  Dim arrInit As Variant      ' Initial Array
  Dim arrResult As Variant    ' Resulting Array
  Dim lngLastRow As Long      ' Last Row Calculator
  Dim lngArr As Long          ' Array Row Counter
  Dim lngArr2 As Long         ' Array Additional Sort Row Counter
  Dim iArr As Integer         ' Array Columns Counter
  Dim vntArr As Variant       ' Array Temporary Variable
  Dim lngUnique As Long       ' (Unique) Months Count(er)
'*******************************************************************************
' Objects

  ' In Workbook
  With ThisWorkbook
    If cStrSheet <> "" Then
      Set objWs = .Worksheets(cStrSheet)
     Else
      Set objWs = .ActiveSheet
    End If
  End With

  ' In Worksheet
  With objWs
    ' Define last row of data.
    If cLngLastRow <> 0 Then ' Last row is defined.
      lngLastRow = cLngLastRow
     Else ' Last row isn't defined, has to be calculated.
      If .Cells(.Rows.Count, cStrDateCol) = "" Then ' Last cell is empty.
        lngLastRow = .Cells(.Rows.Count, cStrDateCol).End(xlUp).Row
       Else ' Last cell is not empty.
        lngLastRow = .Cells(.Rows.Count, cStrDateCol).Row
      End If
    End If
    ' Paste data into array.
    arrInit = Union(.Range( _
        Cells(cLngFirstRow, cStrDateCol), _
        Cells(lngLastRow, cStrDateCol)), .Range( _
        Cells(cLngFirstRow, cStrSalesCol), _
        Cells(lngLastRow, cStrSalesCol))).Value2
  End With

'*******************************************************************************
' Arrays

  ' Sort initial array by date ascending.
  For lngArr = LBound(arrInit) To UBound(arrInit)
    For lngArr2 = lngArr + 1 To UBound(arrInit)
      If arrInit(lngArr, 1) > arrInit(lngArr2, 1) Then
        For iArr = 1 To 2
          vntArr = arrInit(lngArr2, iArr)
          arrInit(lngArr2, iArr) = arrInit(lngArr, iArr)
          arrInit(lngArr, iArr) = vntArr
        Next
      End If
    Next
  Next

  ' Convert date to months-year string.
  For lngArr = LBound(arrInit) To UBound(arrInit)
    arrInit(lngArr, 1) = WorksheetFunction.Proper(Format(arrInit(lngArr, 1), _
    cStrMonth1)) & cStrMonth2 & Format(arrInit(lngArr, 1), cStrMonth3)
  Next

  ' Count the number of unique month-year strings to determine the resulting
  ' array's size.
  vntArr = ""
  For lngArr = LBound(arrInit) To UBound(arrInit)
    If vntArr <> arrInit(lngArr, 1) Then
      vntArr = arrInit(lngArr, 1)
      lngUnique = lngUnique + 1
    End If
  Next

  ' Resize resulting array.
  ReDim arrResult(1 To lngUnique, 1 To 2)

  ' Write first column to resulting array.
  vntArr = ""
  lngUnique = 0
  For lngArr = LBound(arrInit) To UBound(arrInit)
    If vntArr <> arrInit(lngArr, 1) Then
      vntArr = arrInit(lngArr, 1)
      lngUnique = lngUnique + 1
      arrResult(lngUnique, 1) = arrInit(lngArr, 1)
    End If
  Next

  ' Write second column to resulting array.
  For lngArr2 = LBound(arrResult) To UBound(arrResult)
    vntArr = 0
    For lngArr = LBound(arrInit) To UBound(arrInit)
      If arrResult(lngArr2, 1) = arrInit(lngArr, 1) Then
        vntArr = vntArr + arrInit(lngArr, 2)
      End If
    Next
    arrResult(lngArr2, 2) = vntArr
  Next

'*******************************************************************************
'Objects

  ' Paste array into range.
  With objWs
    Union(.Range( _
        Cells(cLngFirstRowResult, cStrMonthCol), _
        Cells(cLngFirstRowResult + lngUnique - 1, cStrMonthCol)), .Range( _
        Cells(cLngFirstRowResult, cStrTotalCol), _
        Cells(cLngFirstRowResult + lngUnique - 1, cStrTotalCol))) = arrResult
  End With

  Set objWs = Nothing

End Sub

Answer 3

В сводной таблице щелкните ячейку с датой, выберите в меню «Группа», затем выберите шаг «Месяцы».