Текст в строке повторяющегося столбца

Question

У меня есть таблица Excel, в которой есть коды деталей в столбце, и для каждого кода детали есть 3-4 подраздела (1100-1400) с информацией, которую мне нужно прикрепить к коду детали в виде столбца.

Количество созданных строк зависит от того, есть ли данные, введенные в подраздел 1400. 1100-1300 всегда содержит информацию и должна быть преобразована в таблицу.

Я даже не знаю, с чего начать, поэтому в настоящее время у меня нет кода, чтобы показать

Я добавил изображение того, как представлены данные и как должен выглядеть результат:

Answer 1

Вы могли бы сделать это так

Option Explicit

Sub TransformA()

Dim rg As Range
Dim lastRow As Long, lineNo As Long, i As Long, j As Long
Dim shInput As Worksheet, shResult As Worksheet
Dim vDat As Variant, resDat As Variant
Dim subSection As String

    ' Make sure you run the code with the data in the Activesheet
    Set shInput = ActiveSheet

    ' And you have data which starts in row 4 with the heading in row 3
    ' otherwise adjust accordingly
    lastRow = shInput.Range("A4").End(xlDown).Row
    Set rg = shInput.Range("A4:I" & lastRow)

    vDat = rg
    ReDim resDat(1 To UBound(vDat, 1) * 4, 1 To 4)

    lineNo = 1

    For j = 1 To UBound(vDat, 1)

        For i = 0 To 2

            Select Case i
            Case 0: subSection = "1100"
            Case 1: subSection = "1200"
            Case 2: subSection = "1300"
            End Select

            resDat(lineNo + i, 1) = vDat(j, 1)
            resDat(lineNo + i, 2) = subSection
            resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
            resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)

        Next

        i = 3
        subSection = "1400"

        If Len(vDat(j, 2 + 2 * i)) = 0 And Len(vDat(j, 3 + 2 * i)) = 0 Then
            lineNo = lineNo + 3
        Else
            resDat(lineNo + i, 1) = vDat(j, 1)
            resDat(lineNo + i, 2) = subSection
            resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
            resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)
            lineNo = lineNo + 4
        End If

    Next

    ' Output the result to a new sheet
    Set shResult = Sheets.Add

    With shResult
        .Cells(1, 1).Value = "Part Code"
        .Cells(1, 2).Value = "Subsection"
        .Cells(1, 3).Value = "Time"
        .Cells(1, 4).Value = "Text"
    End With

    shResult.Range("A2").Resize(UBound(resDat, 1), 4) = resDat

End Sub