分享一个简单的工作计划表

shiyanbo

代码：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$2" And Target.Count <> 1 Then
   Exit Sub
Else
   Application.ScreenUpdating = False
   Dim a(1 To 6) As Integer
   Dim i As Integer
   Dim DayCount As Integer
   i = 1
   Rows("4:34").Hidden = False
   Range("b4:b34").UnMerge
   Range("e4:e34").UnMerge
With Range("b4:h34")
   .Borders.LineStyle = xlContinuous
   .Borders.Weight = xlMedium
   .Borders(xlInsideVertical).LineStyle = xlContinuous
   .Borders(xlInsideVertical).Weight = xlHairline
   .Borders(xlInsideHorizontal).LineStyle = xlContinuous
   .Borders(xlInsideHorizontal).Weight = xlHairline
End With
DayCount = Day(DateSerial(Sheets("para").[a2], Range("d2") + 1, 0))
For Each rng In Range("c4:c34")
    If Weekday(rng.Value, 2) = 1 Then
    a(i) = rng.Row
    i = i + 1
    End If
Next
If a(1) <> 4 Then
Range("b4", "b" & a(1) - 1).Merge
Range("e4", "e" & a(1) - 1).Merge
End If
For j = 1 To i - 2
  Range("b" & a(j), "b" & a(j + 1) - 1).Merge
  Range("e" & a(j), "e" & a(j + 1) - 1).Merge
Next
Range("b" & a(i - 1), "b" & DayCount + 3).Merge
Range("e" & a(i - 1), "e" & DayCount + 3).Merge


If DayCount <> 31 Then Rows(DayCount + 4 & ":" & 34).Hidden = True
Application.ScreenUpdating = True
End If
End Sub

yhq124