是否有一个excel函数通过仅增加一个单元格来复制同一行

Question

我正在过滤一些Excel数据，但在这种情况下遇到了问题：
我的单元格内容如

 1-5 / x

我想复制同一行，但包含1-5 / x的单元格必须为

1 / x
2 / x
3 / x
4 / x
5 / x

有没有办法用vba做到这一点？

Answer 1

请记住，尝试一下，我已经完成了一系列与您的数据集有关的假设。

在工作簿中，创建一个名为“ 已转换”的新工作表。现在进入VBA编辑器并创建一个新模块，并粘贴以下代码...

Public Sub TransformData()
    On Error GoTo CleanUp

    Dim rngCells As Range, objCell As Range, lngFrom As Long, lngTo As Long
    Dim i As Long, strAfter As String, shOutput As Worksheet, lngWriteRow As Long
    Dim objEndCell As Range, objCopyRange As Range

    Set rngCells = Selection
    Set shOutput = Sheets("Transformed")

    shOutput.Cells.Clear

    lngWriteRow = 1

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each objCell In rngCells
        With objCell.Worksheet
            Set objEndCell = .Cells(objCell.Row, .Columns.Count).End(xlToLeft)
            Set objCopyRange = .Range(.Cells(objCell.Row, 2).Address, objEndCell.Address)
        End With

        If InStr(1, objCell.Text, "-") > 0 And InStr(1, objCell.Text, "/") > 0 Then
            lngFrom = Split(Split(objCell.Text, "/")(0), "-")(0)
            lngTo = Split(Split(objCell.Text, "/")(0), "-")(1)

            strAfter = Split(objCell.Text, "/")(1)

            For i = lngFrom To lngTo
                shOutput.Cells(lngWriteRow, 1) = i & "/" & strAfter
                objCopyRange.Copy shOutput.Cells(lngWriteRow, 2)

                lngWriteRow = lngWriteRow + 1
            Next
        Else
            shOutput.Cells(lngWriteRow, 1) = objCell.Text
            objCopyRange.Copy shOutput.Cells(lngWriteRow, 2)

            lngWriteRow = lngWriteRow + 1
        End If
    Next

    Worksheets("Transformed").Activate

CleanUp:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

...现在，选择要为其转换数据的所有单元格。

运行宏，然后检查“已转换”工作表的输出。

我希望您能做得到。