****已经解决 ，，

ppsnow

Windows(w).Activate
   Sheets(s).Activate
   Range("J21:J" & ende).Select　　＇在表中以j列作为判断，
   For i = 1 To ActiveSheet.UsedRange.Rows.Count
   If ActiveCell.Value < Date Then ’如果项目的结束日期小于今天
   ActiveCell.EntireRow.Delete   ’则删除该行B：J 区域的内容，但是Q以后的行列都保持不变化，





   Else
   ActiveCell.EntireRow.Show
   ActiveCell.Offset(1, 0).Select
   End If
   Next i 依次寻找， 删除符合条件的数据。


鬼主， 这样有没有明白我的意思，

ppsnow

为了不沉下去，我再努力一把，

方漠

试试这个是不是你想要的结果?

If ActiveCell.Value < Date Then
   'ActiveCell.EntireRow.Delete
    Range("B" & i & ":I" & i).Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("J" & i).Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
   Else

ppsnow

方漠哥哥，，运行后的结果是K列以前的全都清除了，没有把〉Date的数据保留下来，，，，，

我要的结果是从21行和J列开始把满足〉date的留下，其他的内容清空，清空后把下一条未清除记录填上来，即使数据中没有空行。

[此贴子已经被作者于2006-10-13 13:52:16编辑过]

老鬼

俺呢，就是不明白你的意思，是不是下面这样的？

Selection.Delete Shift:=xlUp

ppsnow

即以j 列（２１行开始）做判断，如果J21开始的单元格的数据＜ｄａｔｅ，那就把相应该行的B：J的内容清除， 依次循环，方漠的程序只是把ｂ到ｊ的内容清除，但是把不该清除的也清楚了，执行完之后一片空白。　

清除完之后，那就有空白行了吗，但是不能有，要把未删除的数据都相应移上来，　比如说：３４行ｂ：ｊ的内容和格式被清除了，但是３５行没有清除，那就要把３５行的数据放到３４行，３６的数据放到３５行。。。。。。

我的表达估计有问题，唉，，，急得了，我做梦都在想，，，，　

ppsnow

期待中，，，，，，，，，

老鬼

按你的意思，我写的那句不就行了吗

ppsnow

对的， 你写的没有错，可是程序整个运行后的结果还是不对，

用方漠的程序，结果不对的，结果是把所有的数据都删了，没有保存任何的数据，

[此贴子已经被作者于2006-10-16 13:50:26编辑过]

ppsnow

继续等待，，，，，