用VBA符合条件的数据复制到另一个工作表中

2021-07-01 22:59:11  阅读 216 次 评论 0 条

要求:表2中J列为条件,符合条件的行全部复制到表1中


不解释,直接上两段代码,SHEET2中第十列,也就是J列中,符合条件的,复制行到表1中。

Sub xx()

    On Error Resume Next

    Dim x As Long

    x = Sheets("newsheet").Range("a65536").End(xlUp).Row() + 1

    For i = 1 To Sheet1.Range("a65536").End(xlUp).Row()

        If Sheet1.Cells(i, "J") = 1 Then

            Sheet2.Rows(i).Copy

            Sheet1.Select

            Rows(x).Select

            ActiveSheet.Paste

            x = x + 1

        End If

    Next i

End Sub

以上代码,表2中J列的条件是:1


Sub 筛选()

    Dim i, n, arr, brr, a#

    arr = [a1].CurrentRegion

    a = InputBox("请输入筛选的数字", "数字")

    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

    For i = 2 To UBound(arr)

        If arr(i, 10) = a Then

            n = n + 1

            For j = 1 To UBound(arr, 2)

                brr(n, j) = arr(i, j)

            Next

        End If

    Next

    Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr

    MsgBox "OK"

End Sub


以上代码,查找表2中第十列中等于你输入的复制到表1中



好吧,结束了才晓得,只能输入数字,不能汉字,下面是折腾汉字,还没测试


Sub 筛选()

    Dim i, n, arr, brr

    arr = [a1].CurrentRegion

    a = InputBox("请输入筛选的关键词", "关键词")

    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

    For i = 2 To UBound(arr)

        If arr(i, 10) = a Then

            n = n + 1

            For j = 1 To UBound(arr, 2)

                brr(n, j) = arr(i, j)

            Next

        End If

    Next

    Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr

    MsgBox "OK"

End Sub


WPS达师专注于免费分享WPS Office使用教程、PPT、word模板及办公常用软件等资源,欢迎大家收藏和分享本站。
WPS表格数据付费处理请加QQ:3247742

发表评论


表情

还没有留言,还不快点抢沙发?