Я бы сделал это по-другому.
Вам необходимо знать даты начала и окончания, а также у вас должен быть список ВСЕХ классификаций и связанных с ними классов.(Я жестко запрограммировал оба в макросе, но вы можете использовать другие схемы).
Из этого вы можете создать таблицу со всеми классами и всеми часами для всех дат.
Как только вы это сделаете, вы можете посмотреть, доступны ли итоги для комбинации классификация / дата, и либо записать это в ноль, либо, если его нет, указать *. 1007 *
Я использовалобъект класса, который содержит информацию.Каждый из этих объектов имеет коллекцию (словарь) всех date_hr |общее количество комбинаций, доступных для этой классификации, а также метод для возврата класса для данной классификации.
Работа с массивами VBA на несколько порядков быстрее, чем многократное чтение / запись в / из таблиц.
Надеюсь, я прокомментировал код достаточно, чтобы вы могли понять, что происходит.Для превосходного обсуждения объектов класса, см. Поздний Chip Pearsons Введение в классы . Если эта ссылка исчезнет, вам необходимо выполнить поиск в Интернете .Там также есть статья о чтении / записи массивов в / из диапазонов рабочих листов, которые вы найдете полезными.
Внимательно прочитайте комментарии, особенно в начале каждого модуля, чтобы правильно настроить их, иначе, он не запустится.
Предполагается, что ваши данные имеют строку заголовка и начинаются с A1.
Результаты размещаются на одном листе, но это должно бытьОчевидно, как это изменить.
Класс модуля
'**Rename this module: cClass**
Option Explicit
Private pClass As String
Private pClassification As String
Private pDate_HR As Date
Private pDate_HRs As Dictionary
Public Property Get class() As String
Select Case Me.Classification
Case "1"
class = "Freshman"
Case "2"
class = "Sophomore"
Case "3"
class = "Junior"
Case "4"
class = "Senior"
Case "GR"
class = "Graduate"
Case "SB"
class = "Second Bachelor"
Case "0"
class = "NDG"
Case Else
class = "N/A"
End Select
End Property
Public Property Get Classification() As String
Classification = pClassification
End Property
Public Property Let Classification(Value As String)
pClassification = Value
End Property
Public Property Get Date_HR() As Date
Date_HR = pDate_HR
End Property
Public Property Let Date_HR(Value As Date)
pDate_HR = Value
End Property
Public Property Get Date_HRs() As Dictionary
Set Date_HRs = pDate_HRs
End Property
Public Function addDate_HRsItem(dtHR As Date, toTAL As Long)
Date_HRs.Add Key:=dtHR, Item:=toTAL
End Function
Private Sub Class_Initialize()
Set pDate_HRs = New Dictionary
pDate_HRs.CompareMode = TextCompare
End Sub
Обычный модуль
Option Explicit
'set reference to microsoft scripting runtime
Sub fillData()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim I As Long, J As Long
Dim dD As Dictionary, cc As cClass
Dim sKey As String, sDTkey As Date
'set source and results worksheets, range
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
Set rRes = wsRes.Cells(1, 7)
'read source data into vba array
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=4)
End With
'Process the known data
'collect it into a dictionary for fast lookups
Set dD = New Dictionary
dD.CompareMode = TextCompare
For I = 2 To UBound(vSrc, 1)
Set cc = New cClass
With cc
.Classification = vSrc(I, 1)
.Date_HR = convDTHR(vSrc(I, 3))
.addDate_HRsItem .Date_HR, CLng(vSrc(I, 4))
sKey = .class
If Not dD.Exists(sKey) Then
dD.Add sKey, cc
Else
dD(sKey).addDate_HRsItem .Date_HR, CLng(vSrc(I, 4))
End If
End With
Next I
'Create Results Array
'Unclear from your question how many dates you want, so will
' just do Mar 4
Const dtStart As Date = #3/4/2019#
Const dtEnd As Date = #3/5/2019#
'code the list of all Classifications
Dim arrClass
arrClass = Array(0, 1, 2, 3, 4, "GR", "SB")
ReDim vRes(0 To (dtEnd - dtStart + 1) * 24 * (UBound(arrClass) + 1), 1 To 4)
'write the column Headers into a results array
For J = 1 To 4
vRes(0, J) = vSrc(1, J)
Next J
'fill in other columns
For I = 1 To UBound(vRes, 1) Step UBound(arrClass) + 1
For J = 0 To UBound(arrClass)
vRes(I + J, 1) = arrClass(J) 'Classification
vRes(I + J, 2) = convCLASS(arrClass(J)) 'class
vRes(I + J, 3) = Format(dtStart + Int((I + J - 1) / (UBound(arrClass) + 1)) / 24, "dd-mmm-yyyy hh") 'The Date_hr
sKey = vRes(I + J, 2) 'key into dictionary
If dD.Exists(sKey) Then
sDTkey = convDTHR(vRes(I + J, 3)) 'key into collection of date/totals within the dictionary item
If dD(sKey).Date_HRs.Exists(sDTkey) Then
vRes(I + J, 4) = dD(sKey).Date_HRs(sDTkey)
Else
vRes(I + J, 4) = 0
End If
Else
vRes(I + J, 4) = 0
End If
Next J
Next I
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
.Columns(1).HorizontalAlignment = xlCenter
.EntireColumn.AutoFit
End With
End Sub
Private Function convDTHR(strDTHR) As Date
convDTHR = CDate(Left(strDTHR, 11)) + Right(strDTHR, 2) / 24
End Function
Private Function convCLASS(strClassification) As String
Dim cc As cClass
Set cc = New cClass
With cc
.Classification = strClassification
convCLASS = .class
End With
End Function