根据条件提取数据，求老师指导！

那时雨

3190496160

Sub Collect()
    Dim arr, brr(), Str, r&, n&, k&, LastRow&, sht As Worksheet
    ReDim brr(1 To 50000, 1 To 4)
    Application.ScreenUpdating = False
    For Each sht In Worksheets
        If sht.Name <> "重大异常履历" Then
            arr = sht.UsedRange
            For r = 4 To UBound(arr)
                If Trim(arr(r, 3)) = "" Then arr(r, 3) = arr(r - 1, 3)
                If Trim(arr(r, 4)) <> "" And Trim(arr(r, 5)) = "" Then arr(r, 5) = arr(r, 4)
                If arr(r, 8) = "1" Then
                    n = n + 1
                    brr(n, 1) = arr(1, 1)
                    brr(n, 2) = arr(r, 3)
                    brr(n, 3) = arr(r, 4)
                    brr(n, 4) = arr(r, 5)
                End If
            Next r
        End If
    Next sht
    With Sheets("重大异常履历")
        .UsedRange.Offset(2) = Empty
        .UsedRange.Offset(2).Borders.LineStyle = 0
        .[a3].Resize(n, UBound(brr, 2)) = brr
        .[a3].Resize(n, UBound(brr, 2)).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = True
    MsgBox "ok!"
End Sub

3190496160

202211月设备设施日报.rar (33.22 KB, 下载次数: 12)

2022-11-26 10:46 上传

点击文件名下载附件

3190496160

使用表格太随心所欲，没有考虑到后期处理，做表格的一个基本点：如果还有后期处理，尽量不合并单元格，

蓝桥玄霜

日报的例子：

那时雨

蓝桥玄霜 发表于 2022-11-26 10:55
日报的例子：

老师厉害啊！是我练习不够，没有发现问题所在。这里我忘记设置工作表范围了。没有限制工作表默认为当前工作表！记住啦。

那时雨

3190496160 发表于 2022-11-26 10:47
使用表格太随心所欲，没有考虑到后期处理，做表格的一个基本点：如果还有后期处理，尽量不合并单元格，

老师说的太对啦！

msnmurong

3190496160 发表于 2022-11-26 10:46
Sub Collect()
    Dim arr, brr(), Str, r&, n&, k&, LastRow&, sht As Worksheet
    ReDim brr(1 To 5 ...

老师 麻烦你看看我这个帖子要怎么实现。https://club.excelhome.net/thread-1648041-1-1.html

tanglf188

先取消合并单元格，执行代码，再合并单元格

那时雨

tanglf188 发表于 2022-12-2 17:16
先取消合并单元格，执行代码，再合并单元格

版主 蓝桥玄霜 老师帮我指出了问题所在，已正常运行。如果取消合并单元格我觉得要麻烦一些。不过还是谢谢你的关注！