excel - 找到 Mr & Mrs 时插入额外的行，然后将数据复制到空白行

Question

所以我有看起来像这样的数据:


姓名
标题
称呼


能源部
J先生和E夫人
约翰和伊莱恩

史密斯
K先生和M夫人
肯和玛格丽特

琼斯
R先生
鲍勃


我需要识别包含 Mr & Mrs 的行，并给他们各自的行。所以我希望它看起来像这样:


姓名
标题
称呼


能源部
J先生
约翰

能源部
E夫人
伊莱恩

史密斯
K先生
肯

史密斯
米夫人
玛格丽特

琼斯
R先生
鲍勃


请有人可以帮助一些代码来做到这一点？

Answer 1

下面的解决方案针对您的三列进行编码，使其位于 A、B 和 C 列中。此循环从数据底部向上运行，以便更轻松地处理插入的行。

Sub split_rows()
    Dim s As Worksheet
    Dim r As Long
    Dim title_position As Integer
    Dim saluation_position As Integer
    Dim title As String
    Dim salutation As String
    Dim last_row As Long
    
    Const name_column = 1
    Const title_column = 2
    Const salutation_column = 3
    
    
    Set s = ActiveSheet 'use the line to process the active sheet
    'set s = worksheets("Sheet1") ' use this line to process a specific sheet
    
    ' this loop works from the bottom of the worksheet up.
    ' the code is simpler that working top-down.
    last_row = s.Cells(s.Rows.Count, title_column).End(xlUp).Row
    For r = last_row To 2 Step -1
        Debug.Print s.Cells(r, 1).Value
        title_position = InStr(1, s.Cells(r, title_column).Value, "&")
        saluation_position = InStr(1, s.Cells(r, salutation_column).Value, "&")
          
        If title_position > 0 And saluation_position > 0 Then
            ' found ampersands in title and salution, let's to split the data
            
            'put joint title and salutation values in variables to make the code easier to read
            title = s.Cells(r, title_column).Value
            salutation = s.Cells(r, salutation_column).Value
            
            s.Rows(r).Insert  ' add a row
            
            ' put the the name (unchanged) in the new row
            s.Cells(r, name_column).Value = s.Cells(r + 1, name_column).Value
            
            ' put half the title in each row
            s.Cells(r, title_column).Value = Trim(Split(title, "&")(0))
            s.Cells(r + 1, title_column).Value = Trim(Split(title, "&")(1))
            
            ' put half the salutation in each row
            s.Cells(r, salutation_column).Value = Trim(Split(salutation, "&")(0))
            s.Cells(r + 1, salutation_column).Value = Trim(Split(salutation, "&")(1))
      End If
    Next


End Sub