剪切满足条件的整行数据到其他工作表中

66215757

请高手帮我看看！把【计划】工作表中，状态为“完工”的整行数据自动剪切到【已完工】工作表中！请对应附件查看

[ 本帖最后由 66215757 于 2011-5-11 10:10 编辑 ]

xrs08234

没有把要求讲清楚。

lenghonghai

Private Sub CommandButton1_Click()
Dim cn As Object
Set cn = CreateObject("adodb.connection")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.FullName
x = Range("b65536").End(xlUp).Row
mysql = "select * from [计划$a4:j" & x & "] where f9='完工'"
Sheet1.Range("a2").CopyFromRecordset cn.Execute(mysql)
cn.Close
End Sub

66215757

楼上VB代码放在那里？谢谢

lenghonghai

Private Sub CommandButton2_Click()
Dim i%, x%, m%
m = 2
x = Range("b65536").End(xlUp).Row
For i = 4 To x
    If Range("i" & i) = "完工" Then
        Range("a" & i).Resize(1, 10).Cut Sheet1.Range("a" & m)
        m = m + 1
    End If
Next i
End Sub

gdfcx

Sub Macro1()
    Dim arr, brr(), i&, j&, m&, n%
    arr = Sheet3.[a3].CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = UBound(arr) To 4 Step -1
        If arr(i, 9) = "完工" Then
            m = m + 1
            For n = 1 To UBound(arr, 2)
                brr(m, n) = arr(i, n)
            Next n
            Sheet3.Rows(i).Delete
        End If
    Next i
    j = Sheet1.[b65536].End(xlUp).Row
    Sheet1.Range("a" & j + 1).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

gdfcx

副本计划完成情况.rar (37.13 KB, 下载次数: 511)

2011-5-11 10:31 上传

点击文件名下载附件

myyj821001

我也需要这个功能，把已完工的整列自动剪切到另一个表中，而原表可以重新输入新数据，上面的符件我下了研究了，但无法运行，请大虾多多帮助，俺是菜鸟，在此谢谢了

山山好又快

gdfcx 发表于 2011-5-11 10:31

试了您的代码内容是复制过去了，但有个问题：计划表中增加时，复制重复，能否加个刷新代码，将以前复制的复盖更新就好了。

gdfcx

山山好又快 发表于 2011-11-12 10:24
试了您的代码内容是复制过去了，但有个问题：计划表中增加时，复制重复，能否加个刷新代码，将以前复制的 ...

你说的所谓增加应该是修改原来完工过的，这个就要去已完工表中去修改。
如果有新需求可以新开贴在站内求助。