有偿请高手帮写个vba

Sub 计算移剪日期和剩余天数()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim 种植日期 As Date
Dim 移剪到期日 As Date
Dim 剩余天数 As Long
Dim 今天日期 As Date
' 设置当前工作表
Set ws = ThisWorkbook.Worksheets("工作表1")
' 获取今天的日期
今天日期 = Date
' 获取数据的最后一行
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 从第4行开始遍历数据行
For i = 4 To lastRow
' 先判断种植日期单元格是否为空
If IsDate(ws.Cells(i, "C").Value) Then
种植日期 = ws.Cells(i, "C").Value
' 根据B列判断是移植还是剪枝
Select Case Trim(ws.Cells(i, "B").Value)
Case "移植"
' 移植规则：第6年移植一次，第10年起每年移植
If DateDiff("yyyy", 种植日期, 今天日期) < 6 Then
' 未满6年，到期日为种植日期+6年，且为该月最后一天
移剪到期日 = DateSerial(Year(种植日期) + 6, Month(种植日期) + 1, 0)
ElseIf DateDiff("yyyy", 种植日期, 今天日期) < 10 Then
' 6-10年之间，到期日为种植日期+10年，且为该月最后一天
移剪到期日 = DateSerial(Year(种植日期) + 10, Month(种植日期) + 1, 0)
Else
' 满10年，到期日为今年的种植月份最后一天
移剪到期日 = DateSerial(Year(今天日期), Month(种植日期) + 1, 0)
' 如果今年的日期已过，则自动顺延到明年
If 移剪到期日 < 今天日期 Then
移剪到期日 = DateSerial(Year(今天日期) + 1, Month(种植日期) + 1, 0)
End If
End If
Case "剪枝"
' 剪枝规则：前5年每年一次，第5年后半年一次
If DateDiff("yyyy", 种植日期, 今天日期) < 5 Then
' 未满5年，到期日为今年的种植月份最后一天
移剪到期日 = DateSerial(Year(今天日期), Month(种植日期) + 1, 0)
' 如果今年的日期已过，则自动顺延到明年
If 移剪到期日 < 今天日期 Then
移剪到期日 = DateSerial(Year(今天日期) + 1, Month(种植日期) + 1, 0)
End If
Else
' 满5年，半年剪一次
If Month(今天日期)

' 满5年，半年剪一次
If Month(今天日期) <= Month(种植日期) Then
' 上半年：到期日为今年种植月份最后一天
移剪到期日 = DateSerial(Year(今天日期), Month(种植日期) + 1, 0)
Else
' 下半年：到期日为今年种植月份+6个月的最后一天
移剪到期日 = DateSerial(Year(今天日期), Month(种植日期) + 7, 0)
' 若计算出的月份超过12，自动跨年
If Month(移剪到期日) > 12 Then
移剪到期日 = DateSerial(Year(移剪到期日) + 1, Month(移剪到期日) - 12, 0)
End If
End If
End If
End Select
' 写入移剪到期日到D列
网页链接 (i, "D").Value = 移剪到期日
' 计算剩余天数并写入E列
剩余天数 = DateDiff("d", 今天日期, 移剪到期日)
ws.Cells(i, "E").Value = 剩余天数
End If
Next i
' 格式化日期列和数字列
ws.Columns("D").NumberFormat = "yyyy/m/d"
ws.Columns("E").NumberFormat = "0"
MsgBox "计算完成！", vbInformation
End Sub

举手之劳不要钱