在 Excel 中将单元格拆分为 2 行

Question

我想在第

Level

列中插入3行。对于

Level

中的单元格，我需要创建 3 行，每行都有值“低”、“中”和“高”。目前，我正在使用一个非常手动的过程，插入另外 2 行，并合并除“Level”之外的所有列。有没有更有效的方法？

原表：

预期输出：

Answer 1

正如@Harun24hr所说 - 你需要VBA来做到这一点。

此代码允许您定义表格的位置、要将标题添加到哪一列以及标题是什么。

'Constants appear at the very top of the module.
Public Const ERR_COL_NOT_FOUND As Long = vbObjectError + 513
Public Const ERR_SINGLE_ROW As Long = vbObjectError + 514

Public Sub Test()

    'Call the AddLevels procedure and pass it the arguments required to work.
    AddLevels ThisWorkbook.Worksheets("Sheet1").Range("B2:G4"), _
              "Level", _
              "Low", "Medium", "High"

End Sub


'Arguments the procedure accepts:
'Target:     The range that the table covers.
'ColName:    The heading that the "Levels" will be placed under.
'Headings(): The heading that need adding - this can be as many headings as you want.
Public Sub AddLevels(Target As Range, ColName As String, ParamArray Headings() As Variant)

    On Error GoTo ErrHandler


    'Number of Headings that are being added.
    'The array starts at 0 so for 3 headings this will return 2.
    'It should be less as the first row already exists.
    Dim RowsToAdd As Long
    RowsToAdd = UBound(Headings)

    'The range must include the headings and at least one row of data.
    If Target.Rows.Count >= 2 Then
    
        'Find the heading we're adding "Headings" to.
        With Target.Rows(1)
            Dim SplitCol As Range
            Set SplitCol = .Find(What:=ColName, _
                                 After:=.Cells(.Cells.Count), _
                                 LookIn:=xlValues, _
                                 LookAt:=xlWhole, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlNext, _
                                 MatchCase:=False)
        End With
            
        If Not SplitCol Is Nothing Then
        
            'Calculate the column within Target.
            'So if Target starts in column B and "Level" is in column E this will return 4.
            'Column E is the fourth column in the range B:G.
            Dim ColNum As Long
            ColNum = SplitCol.Column - Target.Column + 1
        
            Dim x As Long, y As Long
            
            'As we're adding rows we need to start from the bottom and work up
            'otherwise the row count will go astray as extra rows are added.
            For x = Target.Rows.Count To 2 Step -1
                
                'Add the blank rows.
                For y = 1 To RowsToAdd
                    Target.Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Next y
                
                'Paste the Level headings into the correct column.
                Target.Rows(x).Resize(y).Columns(ColNum) = Application.WorksheetFunction.Transpose(Headings)
                
                'Merge the cells except for the Level column.
                Dim Col As Range
                For Each Col In Target.Columns
                    If Col.Column <> SplitCol.Column Then
                        With Col.Rows(x).Resize(y)
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .MergeCells = True
                        End With
                    End If
                Next Col
                
                'Add borders to the new range.
                Dim z As Long
                For z = 7 To 12
                    With Target.Rows(x).Resize(y).Borders(z)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = 0
                    End With
                Next z

            Next x
        
        Else
            'Raise error as the split column wasn't found.
            Err.Raise ERR_COL_NOT_FOUND, , "Column to split not found."
        End If
    Else
        'Raise error as Target only has a single row - which must be the headings.
        Err.Raise ERR_SINGLE_ROW, , "Target must be more than a single row."
    End If
    
TidyExit:
    
Exit Sub 'End of the main body of the procedure.

'Error handling.
ErrHandler:
    MsgBox Err.Number & vbCr & vbCr & Err.Description, vbOKOnly, "Error"
    Resume TidyExit 'Resume execution at this label - giving a single exit point in the procedure.
    
End Sub