Есть ли функция Excel для дублирования одной и той же строки с увеличением только одной ячейки

Question

У меня есть некоторые данные Excel, и у меня возникли проблемы с этим делом:У меня есть содержание клеток, как1-5 / хЯ хочу дублировать одну и ту же строку, но ячейка, содержащая 1-5 / х, должна быть1 / х2 / х3 / х4 / х5 / х

Есть ли способ сделать это с помощью VBA?

Answer 1

Попробуйте, заметьте, я сделал это с кучей предположений, относящихся к вашему набору данных.

В своей рабочей книге создайте новый лист с именем " Transformed ". Теперь перейдите в редактор 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

... теперь выберите все ваши ячейки, для которых вы хотите преобразовать данные.

Запустите макрос, а затем проверьте «Преобразованный» лист для вывода.

Я надеюсь, что это то, что вы хотите.