VBA小程序--新增工作表_核实工作簿中所有工作表表头是否一致（2020-5-13更新升级，提升容错率）

 这是之前的版本，2020-4-1日写的，现在回过来再看当时的代码，真的觉得当时脑子有坑，为什么这么笨，要这么写。。。

Sub 新增工作表_核实工作簿中所有工作表表头是否一致()Dim sht As Worksheet, i As Integeri = 1Sheets.Add.Name = "表头核实"Sheets("表头核实").Move before:=Sheets(1) '将表头移动到最前面'遍历所有工作表，将第一行内容写入For Each sht In ThisWorkbook.Worksheetssht.Rows(1).Copy Worksheets("表头核实").Rows(i)i = i + 1NextWorksheets("表头核实").ActivateColumns(1).SelectSelection.Insert shift:=xlToRightRange("a1:a1").Selecti = 1'遍历所有工作表，将标题内容写入For Each sht In ThisWorkbook.WorksheetsCells(i, 1).FormulaR1C1 = sht.Namei = i + 1Next
End Sub

这是新的版本，2020-5-13日写的，代码简洁了一些，也避免了因为插入第一列会有出错的可能（最初是复制整行，但是如果整行都有格式，那么插入第一列的时候就会报错，无法插入）

Sub 新增工作表_核实工作簿中所有工作表表头是否一致_升级版()Dim sht As Worksheet, i As Integer, arr() As Long, r_num As Long, j As LongSheets.Add.Name = "表头核实"Sheets("表头核实").Move before:=Sheets(1)   '将表头移动到最前面'遍历所有工作表，将第一行内容写入，之前是将整行写进去，但是改进之后，现在只写入有内容的数据For Each sht In Worksheetssht.Activatei = i + 1   'i 默认的初始值是0Worksheets("表头核实").Cells(i, 1) = sht.Namer_num = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Columnsht.Range(Cells(1, 1), Cells(1, r_num)).Copy Worksheets("表头核实").Cells(i, 2)NextWorksheets("表头核实").ActivateMsgBox ("大哥，已完成")
End Sub

本文来自互联网用户投稿，文章观点仅代表作者本人，不代表本站立场，不承担相关法律责任。如若转载，请注明出处。 如若内容造成侵权/违法违规/事实不符，请点击【内容举报】进行投诉反馈！