把符合条件的工作表信息复制到另一个表中

全党

shiruiqiang 发表于 2022-11-27 12:21
Sub text()
Dim arr, brr
Dim x, y, k

谢谢家人

lushang2018

刚看到，有什么问题继续聊

全党

lushang2018 发表于 2022-11-27 17:01
刚看到，有什么问题继续聊

就是要这个效果

全党

lushang2018 发表于 2022-11-27 17:01
刚看到，有什么问题继续聊

还得麻烦你一下，就是我要把所有单位的报表，如果第四列状态是在职都汇总到sheet1中。

lushang2018

全党 发表于 2022-11-27 18:55
还得麻烦你一下，就是我要把所有单位的报表，如果第四列状态是在职都汇总到sheet1中。

你得一次性的 把要求讲完，最后要什么样的表格，有个样子，哪怕是手写的拍个图片也行，不能让大家来猜想结果是什么

yanglinzi

Sub 按条件筛选()
Dim arr, brr, i, j, k
r = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
arr = Sheet1.Range("a4:x" & r)
x = Array(1, 2, 3, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16)
ReDim brr(1 To UBound(arr), 1 To 13)
For i = 1 To UBound(arr)
    If arr(i, 4) = "建投员工" And arr(i, 6) = "封控" Then
        m = m + 1
        a = 1
        For j = 0 To UBound(x)
            brr(m, a) = arr(i, x(j))
            a = a + 1
        Next
    End If
Next
Sheet4.[a4].Resize(m, 13) = brr
End Sub

yanglinzi

是这样吗？请测试

全党

yanglinzi 发表于 2022-11-27 20:03
是这样吗？请测试

问题解决，谢谢

全党

lushang2018 发表于 2022-11-27 19:14
你得一次性的 把要求讲完，最后要什么样的表格，有个样子，哪怕是手写的拍个图片也行，不能让大家来猜想 ...

打扰了，开疫情会刚回来。是我没说清，把要求图片放到附件压缩包里了，谢谢你的支持。