Упростить громоздкий
Несмежная версия
Sub Bulky()
' Sheet Name, Cells List, Date Cell, Weeks List, Days in Week
Const cSheet As String = "Monthly Status"
Const cCells As String = "K34,K33,K32,K31,K30,K29,K28,K27,K26,K25,K24"
Const cDateCell As String = "K36"
Const cWeeks As String = "6,8,9,11,12,19,20,22,23,26,26"
Const cDays As Long = 7
Dim vntC As Variant ' Cells Array
Dim vntW As Variant ' Weeks Array
Dim RefDate1 As Date ' Date
Dim i As Long ' Arrays Row Counter
With Sheets(cSheet)
RefDate1 = .Range(cDateCell).Value
If RefDate1 = False Then
.Range(cCells).ClearContents
Else
vntC = Split(cCells, ",")
vntW = Split(cWeeks, ",")
For i = 0 To UBound(vntC)
.Range(vntC(i)).Value = RefDate1 - (cDays * CLng(Trim(vntW(i))))
Next
End If
End With
End Sub
Смежный (K24: K34) Быстрая версия
Sub Bulky2()
' Sheet Name, Source Range, Date Cell, Weeks List, Days in Week
Const cSheet As String = "Monthly Status"
Const cCells As String = "K24:K34"
Const cDateCell As String = "K36"
Const cWeeks As String = "26,26,23,22,20,19,12,11,9,8,6"
Const cDays As Long = 7
Dim vntT As Variant ' Target Array
Dim vntW As Variant ' Weeks Array
Dim RefDate1 As Date ' Date
Dim i As Long ' Arrays Row Counter
With Sheets(cSheet)
RefDate1 = .Range(cDateCell).Value
If RefDate1 = False Then
.Range(cCells).ClearContents
Else
vntW = Split(cWeeks, ",")
ReDim vntT(1 To UBound(vntW) + 1, 1 To 1)
For i = 1 To UBound(vntT)
vntT(i, 1) = RefDate1 - (cDays * CLng(Trim(vntW(i - 1))))
Next
.Range(cCells) = vntT
End If
End With
End Sub