|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Private Sub Worksheet_Change(ByVal T As Range)
If T.Row = 2 And T.Column = 27 Then
If T.Value = "" Then [ah2] = ""
rq = T.Value
[ah2] = Year(rq) & "/" & Month(rq) & "/" & Day(DateSerial(Year(rq), Month(rq) + 1, 0))
Dim i As Date
js = Year(rq) & "/" & Month(rq) & "/" & Day(DateSerial(Year(rq), Month(rq) + 1, 0))
y = 2
ys = Cells(3, Columns.Count).End(xlToLeft).Column
r = Cells(Rows.Count, 1).End(xlUp).Row
If r > 4 And ys > 3 Then Range(Cells(3, 2), Cells(r - 1, ys)).Clear
Rows("3:3").NumberFormatLocal = "m""月""d""日"";@"
For i = rq To js
xq = Weekday(i, 2)
If xq <> 7 And xq <> 7 Then
Cells(3, y) = i
Cells(4, y) = "早"
Cells(4, y + 1) = "中"
Cells(4, y + 2) = "晚"
Cells(3, y).Resize(1, 3).Merge
y = y + 3
End If
Next i
'y = y + 3
Cells(3, y) = "小计"
Cells(4, y) = "早"
Cells(4, y + 1) = "中"
Cells(4, y + 2) = "晚"
Dim s As Integer
For s = 5 To r
Cells(s, y).FormulaR1C1 = "=SUMIFS(RC[-" & y - 2 & "]:RC[-1],R[-" & s - 4 & "]C[-" & y - 2 & "]:R[-" & s - 4 & "]C[-1],R[-" & s - 4 & "]C)"
Cells(s, y + 1).FormulaR1C1 = "=SUMIFS(RC[-" & y + 1 - 2 & "]:RC[-2],R[-" & s - 4 & "]C[-" & y + 1 - 2 & "]:R[-" & s - 4 & "]C[-2],R[-" & s - 4 & "]C)"
Cells(s, y + 2).FormulaR1C1 = "=SUMIFS(RC[-" & y + 2 - 2 & "]:RC[-3],R[-" & s - 4 & "]C[-" & y + 2 - 2 & "]:R[-" & s - 4 & "]C[-3],R[-" & s - 4 & "]C)"
Cells(s, y + 3).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Next s
Cells(3, y).Resize(1, 3).Merge
y = y + 3
Cells(3, y) = "总计金额"
Cells(3, y).Resize(2, 1).Merge
Cells(3, y + 1) = "交款人签字"
Cells(3, y + 1).Resize(2, 1).Merge
Columns(y).ColumnWidth = 15
Columns(y + 1).ColumnWidth = 15
Range(Cells(3, 2), Cells(r, y + 1)).Borders.LineStyle = 1
End If
End Sub
|
|