Question

需要转换

由于行已锁定并从其他位置导入，因此无法更改以上内容以使每行重复mtown和waco。

最终结果/报告应如下所示：

想使用excel公式执行此操作，但无法弄清楚。

也希望成为将来的证明，如果在43之后添加了另一个数字，它还将更改结果/报告并在mtown下添加新数字。

编辑：包含具有行和列索引的图像

Answer 1

这是一种快速的VBA方法。

Sub FreakyPeopleFormat()

    Dim rngCell As Range 'cell we are processing
    Dim location As String 'waco, mtown
    Dim lastCell As Integer 'last populated cell on the sheet
    Dim writeCell As Range 'cell to write to

    'set initial write cell
    Set writeCell = Sheet1.Range("F2")

    'get the last cell
    lastCell = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row()

    'loop through the data
    For Each rngCell In Sheet1.Range("C2:C" & lastCell)

        'capture location if it's changed
        If location <> rngCell.Offset(, -1).Value And rngCell.Offset(, -1).Value <> "" Then
            If location <> "" Then 'write it out again
                writeCell.Value = location
                'move to next cell and write location
                Set writeCell = writeCell.Offset(1)
            End If

            'capture and write out location
            location = rngCell.Offset(, -1).Value
            writeCell.Value = location
            Set writeCell = writeCell.Offset(1)
        End If

        'process the line
        writeCell.Value = rngCell.Value

        'increment the writeCell
        Set writeCell = writeCell.Offset(1)
    Next

    'finally write out the location once more
    writeCell.Value = location
End Sub

Answer 2

还可以尝试：

Option Explicit

Sub X()

    Dim LR As Long, i As Long, j As Long
    Dim rngName As String

    With Worksheets("Sheet1")

        LR = .Cells(.Rows.Count, "B").End(xlUp).Row
        For j = 1 To LR
            If .Cells(j, 1).Value <> "" And Cells(j, 2).Value <> "" Then
                rngName = .Cells(j, 1).Value

                .Cells(j, 2).Select

                Do Until IsEmpty(ActiveCell)
                    If ActiveCell.Offset(, -1).Value <> "" And ActiveCell.Offset(1, -1).Value = "" Then
                        ActiveCell.Offset(1, -1).Value = ActiveCell.Value
                        ActiveCell.Clear
                    ElseIf ActiveCell.Offset(, -1).Value <> "" And ActiveCell.Offset(1, -1).Value <> "" Then
                        ActiveCell.Offset(1, 1).EntireRow.Resize(2).Insert Shift:=xlDown
                        ActiveCell.Offset(1, -1).Value = ActiveCell.Value
                        ActiveCell.Offset(2, -1) = rngName
                        ActiveCell.Clear
                    End If

                   ActiveCell.Offset(1, 0).Select

                Loop

                ActiveCell.Offset(1, -1) = rngName

            End If
        Next j

    End With

End Sub

根据键合并列excel

2 个答案: