关于vba代码运行时错误1004?应用程序定义或对象定义错误问题(vba运行时错误5是怎么回事)怎么可以错过

随心笔谈12个月前发布 admin
91 0

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

© 版权声明

相关文章