Суфифы с критериями даты в VBA - PullRequest
Новая
       17

Суфифы с критериями даты в VBA

0 голосов
/ 26 августа 2018

Я изо всех сил стараюсь сделать Суфифс с кодом ниже. 

Sub Mandays()
Application.ScreenUpdating = False

Dim Summ1 As Double, Summ2 As Double, Summ3 As Double, Summ4 As Double, 
Summ5 As Double
Dim WS1, WS2 As Worksheet
Dim Arr1 As Variant
Dim SumRng1 As Range, SumRng2 As Range, SumRng3 As Range, SumRng4 As Range, 
SumRng5 As Range
Dim CndRng1 As Range, CndRng2 As Range, CndRng3 As Range, CndRng4 As Range, 
CndRng5 As Range, CndRng6 As Range, CndRng7 As Range
Dim tFilter1 As String, tFilter2 As String, tFilter3 As String, tFilter5 As 
String
Dim i As Long, Fstdate As Long, LstDate As Long, X As Long


Set WS1 = Sheets("Daily_Production_Stats")
Set WS2 = Sheets("Master_WDD")
Arr1 = WS1.UsedRange.Value
Set SumRng1 = WS2.Range("P2:P30000")
Set SumRng2 = WS2.Range("W2:W30000")
Set SumRng3 = WS2.Range("AD2:AD30000")
Set SumRng4 = WS2.Range("AK2:AK30000")
Set SumRng5 = WS2.Range("AR2:AR30000")

Set CndRng1 = WS2.Range("J2:J30000")
Set CndRng2 = WS2.Range("Q2:Q30000")
Set CndRng3 = WS2.Range("X2:X30000")
Set CndRng4 = WS2.Range("AE2:AE30000")
Set CndRng5 = WS2.Range("AL2:AL30000")


Set CndRng6 = WS2.Range("D2:D30000")
Set CndRng7 = WS2.Range("F2:F30000")

tFilter1 = WS1.Range("D1")
Fstdate = WS1.Cells(2, 4)
X = WS1.Cells(2, Columns.Count).End(xlToLeft).Column
LstDate = WS1.Cells(2, X).Value


With WS1
.Range("A5:A300").Clear
If CndRng6 >= Fstdate And CndRng6) <= LstDate Then

For i = 3 To UBound(Arr1)
tFilter2 = WS1.Cells(i, 3)
Summ1 = .Application.WorksheetFunction.SumIfs(SumRng1, CndRng1, tFilter1, 
CndRng7, tFilter2)
Summ2 = .Application.WorksheetFunction.SumIfs(SumRng2, CndRng2, tFilter1, 
CndRng7, tFilter2)
Summ3 = .Application.WorksheetFunction.SumIfs(SumRng3, CndRng3, tFilter1, 
CndRng7, tFilter2)
Summ4 = .Application.WorksheetFunction.SumIfs(SumRng4, CndRng4, tFilter1, 
CndRng7, tFilter2)
Summ5 = .Application.WorksheetFunction.SumIfs(SumRng5, CndRng1, tFilter1, 
CndRng7, tFilter2)
.Cells(i, 1).Value = Summ1 / 480
Summ1 = 0
Next i
End If

.Activate
End With

End Sub

Тогда как линия If CndRng6 >= Fstdate And CndRng6) <= LstDate дает мне Type-Mismatch Error. Это сравнение дат.

Может кто-нибудь помочь мне, пожалуйста? Я также пытался использовать CLng и CDate, но у меня ничего не получалось.

1 Ответ

0 голосов
/ 26 августа 2018

Как отметил пользователь "GMalc" в комментариях, вы не можете сравнивать весь диапазон с одним значением. Вам нужно найти первое и последнее значения в диапазоне. Затем сравните их с FstDate и LstDate .

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

'worksheetfunction.min will find the smallest value in the range which should be the first date
'worksheetfunction.max will find the largest value in the range which should be the last date

If WorksheetFunction.Min(CndRng6) >= Fstdate And WorksheetFunction.Max(CndRng6) <= LstDate Then

Надеюсь, это поможет

...