大神帮忙修改下读取问题

透明世界1987

当前运行的代码可以读取，但是存在一个问题，当箱单页有空行时就直接读下一页了，第二个问题是当箱单有隐藏行时隐藏行数据也读取出来了，这两个问题能否优化一下，万分感谢 读取清单.zip (153.28 KB, 下载次数: 4)

2022-9-13 15:37 上传

点击文件名下载附件

zjdh

Sub 汇总666()
10  FLE = Dir(ThisWorkbook.Path & "\*.xls*")
    If FIL = ThisWorkbook.Name Then GoTo 10
    With Workbooks.Open(ThisWorkbook.Path & "\" & FLE)
        ARR = .Sheets("装箱清单").Range("A1:O" & .Sheets("装箱清单").Range("B8000").End(3).Row + 1)
        For I = 1 To UBound(ARR)
            If Cells(I, "A").EntireRow.Hidden = True Then ARR(I, 7) = True
            If ARR(I, 2) = "" Then ARR(I, 7) = True
        Next
        .Close False
    End With
    ReDim brr(1 To UBound(ARR), 1 To 9)
    For I = 1 To UBound(ARR)
        If Trim(ARR(I, 1)) = "设备号" Then
            SBH = Trim(ARR(I, 2))
            If InStr(ARR(I + 2, 2), " ") Then
                XH = Split(ARR(I + 2, 2), " ")(0)
            Else
                XH = ARR(I + 2, 2)
            End If
        End If
        If Trim(ARR(I, 1)) = "序号" Then
            For j = 1 To 50
                I = I + 1
                If I > UBound(ARR) Then Exit For
                If Trim(ARR(I, 1)) = "设备号" Then I = I - 1: Exit For
                If ARR(I, 7) Then
                    GoTo 20
                Else
                    k = k + 1
                    brr(k, 1) = SBH
                    brr(k, 2) = ARR(I, 2)
                    brr(k, 3) = ARR(I, 3)
                    brr(k, 4) = ARR(I, 6)
                    brr(k, 5) = ARR(I, 4)
                    brr(k, 7) = ARR(I, 5)
                    brr(k, 8) = ARR(I, 15)
                    brr(k, 9) = XH
                End If
20          Next
        End If
    Next
    Range("B2:J8000").ClearContents
    Range("B2").Resize(k, 9) = brr
    MsgBox "装箱单已汇总！"
End Sub