Excel 基于图纸名称添加行

我现在在这个问题上有点卡住了——我有一个解决办法，但它效率很低，而且编码也很耗时

我有一个工作表的选择，我想根据工作表名称为每个工作表添加不同的标题行

我想要一个包含标题行选择的工作表-请参阅

然后，例如，如果工作表=A00，则在选择工作表的相应标题行中应用副本

这是我目前的解决方案——正如你所看到的，它效率很低，而且很耗时

For Each myWorksheet In Worksheets
    If myWorksheet.Name = "A00" Then
        Sheets("A00").Cells(1).Resize(1, 5).Value = Array("ORGANISATION_ID", "FILE_TYPE", "CREATION_DATE", "CREATION_TIME", "GENERATION_NUMBER")
    End If
    If myWorksheet.Name = "Z99" Then
        Sheets("Z99").Cells(1).Resize(1, 1).Value = Array("RECORD_COUNT")
    End If
    If myWorksheet.Name = "I56" Then
        Sheets("I56").Cells(1).Resize(1, 26).Value = Array("ORGANISATION_SHORT_CODE", "INVOICE_NUMBER", "INVOICE_TYPE_CODE", "BILLING_YEAR", "BILLING_MONTH", "INVOICE_AMOUNT", "INVOICE_VAT_AMOUNT", "INVOICE_GROSS_TOTAL", "PAYMENT_DUE_DATE", "VAT_CHARGED_TO_NWO", "VAT_CHARGED_TO_SHIPPER", "INVOICE_TAX_POINT_DATE", "NWO_VAT_ REGISTRATION_NUMBER", "NWO_BANK_SORT_CODE", "NWO_BANK_ACCOUNT_NUMBER", "NWO_BANK_ACCOUNT_NAME", "ISH_VAT_REGISTRATION_NUMBER", "ISH_BANK_ACCOUNT_NUMBER", "ISH_BANK_SORT_CODE", "NWO_SHORT_CODE", "NWO_VAT_REGISTRATION_NAME", "NWO_ADDRESS_LINE_1", "NWO_ADDRESS_LINE_2", "NWO_ADDRESS_LINE_3", "NWO_ADDRESS_LINE_4", "FILE_NAME")
    End If
    If myWorksheet.Name = "I05" Then
        Sheets("I05").Cells(1).Resize(1, 2).Value = Array("ISC_LINE_1_TEXT", "ISC_LINE_2_TEXT")
    End If
    If myWorksheet.Name = "I57" Then
        Sheets("I57").Cells(1).Resize(1, 8).Value = Array("INVOICE_ITEM_REFERENCE_NUMBER", "INCURRED_DATE", "CHARGE TYPE CODE", "QUANTITY", "UNIT_TYPE", "RATE", "INVOICE_ITEM_AMOUNT", "ANCILLARY_INVOICE_COMMENTS")
    End If
    If myWorksheet.Name = "K12" Then
        Sheets("K12").Cells(1).Resize(1, 4).Value = Array("GAS_ACT_OWNER", "CURRENT_METER_ASSET_MANAGER", "PROSPECTIVE_METER_ASSET_MANAGER", "PROSPECTIVE_MAM_EFFECTIVE_DATE")
    End If
Next myWorksheet

---

如果您有任何帮助，我们将不胜感激。

创建一个名为Index的工作表，并按照您在图像中所做的那样填充它

然后，下面的代码将处理每个选项卡，如果在列A中找到选项卡名称，它将把该单元格下的整行复制到选项卡的第一行

For Each myworksheet In Worksheets
    rowfound = Application.Match(myworksheet.Name, Worksheets("Index").Range("A:A"), 0)
    If Not (IsError(rowfound)) Then myworksheet.Range("1:1").Value = Worksheets("index").Cells(rowfound + 1, 1).EntireRow.Value
Next

---

我想我可以通过以下列出的步骤来实现这一点，并对您的工作表进行以下假设

• 图像中的工作表名为“标题行选择”
• 图像中的工作表标题之间将有空行 清单如图所示
• 图片中的第一列是 A栏
• 您希望标题从单个的单元格A1开始 床单

台阶

定义图片工作表的范围，我们将在其中搜索每个工作表的名称

循环浏览集合中的每个工作表，在搜索范围中查找其名称

如果找到该名称，请使用找到该名称的范围的CurrentRegion属性定义一个范围。（）

计算该范围内的列数

将该范围向下偏移一行（以排除图纸名称本身）

将该范围调整为一行“高”，列数相同的“宽”

将目标图纸上的标题范围设置为单元格A1，并调整其大小，使其具有正确的列数

将该标题范围的值设置为我们在“标题行选择”工作表上构建的范围的值

---

如果根据图片设置工作表，则可以使用“查找”或“匹配”查找工作表名称并复制相应的标题。

    Dim myWorksheet As Worksheet

    Dim searchRange As Range
    Set searchRange = Worksheets("Selection of Header Rows").Range("A:A")

    Dim foundRange As Range
    Dim headerRange As Range
    For Each myWorksheet In Worksheets

        Set foundRange = searchRange.Find(What:=myWorksheet.Name, LookAt:=xlWhole)

        If Not foundRange Is Nothing Then

            Set headerRange = foundRange.CurrentRegion.Offset(1, 0)

            Dim headerColumnCount As Long
            headerColumnCount = headerRange.Columns.Count

            Set headerRange = headerRange.Resize(1, headerColumnCount)

            myWorksheet.Range("A1").Resize(1, headerColumnCount).value = headerRange.value

        End If

    Next myWorksheet