连续文本到重复列

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