将满足条件的行剪切到另一个工作表中

燕仔

将满足时间条件的一行数据剪切到工作表2.zip (8.88 KB, 下载次数: 154)

2014-2-28 19:07 上传

点击文件名下载附件

  当时间一列中的时间超过系统时间 将这一行剪切到另一个工作表中。

dsmch

没有日期的时间怎么和系统比较？
建议重新编辑附件。

燕仔

dsmch 发表于 2014-2-28 19:22
没有日期的时间怎么和系统比较？
建议重新编辑附件。

就是这样的 原来 zhaogang1960 做好了 只是和现在的工作表不一样， 这个是实际用到的工作表

mmwwdd

呵呵呵 ，看了必须留名

zhaogang1960

1. Private Sub Worksheet_Activate()
   
2.     Dim arr, rng As Range, rngU As Range, m&, d As Date
   
3.     Set rng = Sheets("Sheet1").Range("C8:Z" & Sheets("Sheet1").Range("C65536").End(xlUp).Row)
   
4.     arr = rng
   
5.     d = TimeValue(Now)
   
6.     For i = 1 To UBound(arr)
   
7.         If arr(i, 11) < d Then
   
8.             m = m + 1
   
9.             If m = 1 Then Set rngU = rng.Rows(i) Else Set rngU = Union(rngU, rng.Rows(i))
   
10.         End If
    
11.     Next
    
12.     r = Range("C65536").End(xlUp).Row + 1
    
13.     If r < 8 Then r = 8
    
14.     rngU.Copy Range("c" & r)
    
15.     rngU.EntireRow.Delete
    
16. End Sub
    

复制代码

zhaogang1960

请测试附件
将满足时间条件的一行数据剪切到工作表2.rar (10.55 KB, 下载次数: 217)

2014-2-28 19:39 上传

点击文件名下载附件

燕仔

运行时错误'91‘ 对象变量或with块变量未设置  rngU.Copy Range("c" & r)  麻烦您再给看看。

燕仔

zhaogang1960 发表于 2014-2-28 19:39
请测试附件

运行时错误'91‘ 对象变量或with块变量未设置  rngU.Copy Range("c" & r)  麻烦您再给看看。

zhaogang1960

燕仔 发表于 2014-2-28 20:16
运行时错误'91‘ 对象变量或with块变量未设置  rngU.Copy Range("c" & r)  麻烦您再给看看。

加一个判断

1. Private Sub Worksheet_Activate()
   
2.     Dim arr, rng As Range, rngU As Range, m&, d As Date
   
3.     r = Sheets("Sheet1").Range("C65536").End(xlUp).Row
   
4.     If r < 8 Then Exit Sub
   
5.     Set rng = Sheets("Sheet1").Range("C8:Z" & r)
   
6.     arr = rng
   
7.     d = TimeValue(Now)
   
8.     For i = 1 To UBound(arr)
   
9.         If arr(i, 11) < d Then
   
10.             m = m + 1
    
11.             If m = 1 Then Set rngU = rng.Rows(i) Else Set rngU = Union(rngU, rng.Rows(i))
    
12.         End If
    
13.     Next
    
14.     If m = 0 Then Exit Sub '新加
    
15.     r = Range("C65536").End(xlUp).Row + 1
    
16.     If r < 8 Then r = 8
    
17.     rngU.Copy Range("c" & r)
    
18.     rngU.EntireRow.Delete
    
19. End Sub
    

复制代码

zhaogang1960

请看附件
将满足时间条件的一行数据剪切到工作表2.rar (10.81 KB, 下载次数: 306)

2014-2-28 20:54 上传

点击文件名下载附件