关于vba代码运行时错误1004 应用程序定义或对象定义错误问题

一、错误描述

将Excel所有工作表,汇总到一个工作表中:

在thisworkbook中运行如下:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

Sub 合并所有工作表_在所有行标注工作表名字_无视空行空列_考虑到不规范的多一点的行和列()

    Dim row_num As Long, column_num As Long, row_num_temp As Long, column_num_temp As Long, row_num_merge As Long, column_num_merge As Long, i As Long, arr() As Long

    Worksheets.Add.Name = "合并表"

    Sheets("合并表").Move before:=Sheets(1)

    For i = 2 To Worksheets.Count

        Worksheets(i).Activate

        'UsedRange.row,代表使用的第一个行数,在有空行的时候体现,同理,UsedRange.column,代表使用的第一个列数,在有空列的时候体现

        '那么使用第一行 + 已使用的行数,这样可以规避顶部/左侧有空行,导致获取已使用行号的数据不符合预期(老赵,如果你看到这里不懂,就自己拆开代码,加上空行空列体会一下)

        row_num = Worksheets(i).UsedRange.Row + Worksheets(i).UsedRange.Rows.Count - 1

        column_num = Worksheets(i).UsedRange.Column + Worksheets(i).UsedRange.Columns.Count - 1

        '如果格式很不规范,那么获取的UsedRange.rows.count就可能是整个表格的行数,所以要规避这种情况,如果相同,就让他减1

        If row_num = Worksheets(i).Rows.Count Then row_num = row_num - 1

        If column_num = Worksheets(i).Columns.Count Then column_num = column_num - 1

         

        '相当于遍历所有的列,都按ctrl + ↑,取数组的最大值

        ReDim arr(1 To column_num)

        For j = LBound(arr) To UBound(arr)

            row_num_temp = Worksheets(i).Cells(row_num + 1, j).End(xlUp).Row

            arr(j) = row_num_temp

        Next

        Debug.Print (Application.WorksheetFunction.Max(arr))

        row_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值,确定最大的有数据的行数

         

        '相当于遍历所有的行,都按ctrl + ←,取数组的最大值

        'Erase arr 清空数组,但是也可以不用,直接用ReDim也可以,如果要保留数组内容,需要加一个preserve

        ReDim arr(1 To row_num_temp)

        For j = LBound(arr) To UBound(arr)

            column_num_temp = Worksheets(i).Cells(j, column_num + 1).End(xlToLeft).Column

            arr(j) = column_num_temp

        Next

        Debug.Print (Application.WorksheetFunction.Max(arr))

        column_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值,确定最大的有数据的列数

         

        Worksheets(i).Range(Cells(1, 1), Cells(row_num_temp, column_num_temp)).Select

        Selection.Copy Sheets("合并表").Cells(row_num_merge + 1, 2)

        Worksheets("合并表").Cells(row_num_merge + 1, 1) = Worksheets(i).Name

        row_num_merge = Sheets("合并表").UsedRange.Rows.Count

    Next

    '将首行标题转为所有行(选择空值,=上面的数据)

    Worksheets("合并表").Activate

    Columns("A:A").Select

    Selection.SpecialCells(xlCellTypeBlanks).Select

    Application.CutCopyMode = False

    Selection.FormulaR1C1 = "=R[-1]C"

    Columns("A:A").Select

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False

    Range("A1").Select

End Sub

新建模块,运行如下:

二、原因调查

发现是工作表中数据存在异常,例如:

最下面存在个别数据,导致复制粘贴的时候单元格数量不足,形成此错误;

总结

分享:
“难道生命这漫长进程中所有的努力和希望,都是为了那飞娥扑火的一瞬间?”“飞蛾并不觉得阴暗,它至少享受了短暂的光明。"

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

jh035512

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值