[求助] 多表拆分 出现 运行时错误6 溢出错误

fallrains

在论坛里抄的两表同步拆分宏，今天点击拆分的时候发生了：运行时错误6 溢出，  求助大神该怎么解决，本人菜鸟，只知道用，根本看不懂这个函数。万分感谢！

Sub 两表同步拆分()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set d = CreateObject("Scripting.Dictionary")
    Set wb1 = ThisWorkbook
    For Each sht In Sheets
        arA = sht.[a1].CurrentRegion     此行错误
        For i = 1 To UBound(arA, 2)
            If arA(1, i) = "branch" Then j = i: Exit For
        Next
        For i = 2 To UBound(arA)
            d(arA(i, j)) = ""
        Next
    Next
    k = d.keys: t = d.items
    For i = 0 To UBound(k)
        Application.SheetsInNewWorkbook = wb1.Sheets.Count
        Workbooks.Add
        Set wb = ActiveWorkbook
        With wb
            For x = 1 To wb1.Sheets.Count
                arA = wb1.Sheets(x).[a1].CurrentRegion
                m = 1
                For j = 1 To UBound(arA, 2)
                    If arA(1, j) = "branch" Then jj = j: Exit For
                Next
                For j = 2 To UBound(arA)
                    If arA(j, jj) = k(i) Then
                        m = m + 1
                        wb1.Sheets(x).Cells(j, 1).Resize(1, UBound(arA, 2)).Copy .Sheets(x).Cells(m, 1)
                        wb1.Sheets(x).Cells(1, 1).Resize(1, UBound(arA, 2)).Copy .Sheets(x).[a1]
                    End If
                Next
                Sheets(x).Name = wb1.Sheets(x).Name
                .Sheets(x).[A2].CurrentRegion.Borders.LineStyle = 1
                For y = 1 To UBound(arA, 2)
                    .Sheets(x).Columns(y).ColumnWidth = wb1.Sheets(x).Columns(y).ColumnWidth
                Next
            Next
        End With
        For Each sht In wb.Sheets
            If Len(sht.Cells(2, 1)) = 0 Then sht.Delete
        Next
        wb.SaveAs ThisWorkbook.Path & "\" & k(i) & ".xlsx"
        wb.Close
    Next
    MsgBox "OK"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Sub 合并同名表()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb1 = ThisWorkbook
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsx")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(p & f)
            On Error Resume Next
            For Each sht In wb1.Sheets
                r = wb1.Sheets(sht.Name).[a1].CurrentRegion.Rows.Count + 1
                wb.Sheets(sht.Name).[a1].CurrentRegion.Offset(1).Copy wb1.Sheets(sht.Name).Cells(r, 1)
            Next
            wb.Close False
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "ok"
End Sub

fallrains

前几个月每次都是正常的，今天就突然不行了， 求助

3190496160

这句代码本身没有任何问题的，绝对是你的工作表中的数据有问题，比如，单元格数据非法，负日期等等，

ykcbf1100

有可能是[a1]单元格空白，而且，与[a1]相邻单元格也都是空白。

ykcbf1100

也可以改用这一句试试： arA = sht.Usedrange

fallrains

3190496160 发表于 2024-2-2 17:11
这句代码本身没有任何问题的，绝对是你的工作表中的数据有问题，比如，单元格数据非法，负日期等等，

求助，怎么查找出来非法数据，负日期？

fallrains

ykcbf1100 发表于 2024-2-2 19:05
也可以改用这一句试试： arA = sht.Usedrange

不是A1单元格的问题，我把每个工作表保留前100行，就能正常运行了， 这个溢出应该是某个数据非法了，我不知道怎么能查出来这个非法数据 ，谢谢了

fallrains

数据验证出了问题，搞定了，谢谢大家