将数据循环并复制到新工作表

时间:2018-02-14 16:59:36

标签: excel vba excel-vba

这是我的第一篇文章,但我有一个excel工作簿,其中有多个标签格式如下:

current screenshot

我正在学习vba,但不知道excel功能是否足够好以循环遍历行并将重新格式化的数据复制到这种格式:

expected result

具体来说,我认为我需要 - 初始化工作表范围

  • 循环播放

  • 将b到G的列标题存储到变量中,这样当找到x时,它可以连接或复制到

  • 处理空格,以便每个

  • 使用最后一个值

任何帮助表示赞赏。谢谢!

3 个答案:

答案 0 :(得分:1)

以下内容将符合您的期望:

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
Dim wsResult As Worksheet: Set wsResult = Sheets("Sheet2")
LastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
'get the last row with data on Column J

For i = 2 To LastRow
    NextRow = wsResult.Cells(wsResult.Rows.Count, "D").End(xlUp).Row + 1
    ws.Range("H" & i & ":J" & i).Copy Destination:=wsResult.Range("D" & NextRow)
    wsResult.Range("A" & NextRow).Value = "Title"
    If ws.Cells(i, 1) <> "" Then 'if GroupID is not empty
        wsResult.Range("B" & NextRow).Value = ws.Cells(i, 1) 'grab that GroupID
    Else
        x = i
        Do While Trim(ws.Cells(x, 1)) = ""
            x = x - 1
            Group = ws.Cells(x, 1) 'get the GroupID of the Row above
        Loop
        wsResult.Range("B" & NextRow).Value = Group
    End If

    For y = 2 To 7
        If ws.Cells(i, y) <> "" Then
            Level = ws.Cells(1, y).Value
            Exit For
        End If
    Next y
    wsResult.Cells(NextRow, 3) = Level
Next i
End Sub

答案 1 :(得分:0)

试试这个:

Sub BuildTable()
    Dim data(), i As Integer, j As Integer

    data = Worksheets("Sheet1").Range("A2:J5").Value

    For i = 1 To UBound(data)
        With Worksheets("Sheet2")
            .Range("A" & i) = "Title"
            .Range("D" & i) = data(i, 8)
            .Range("E" & i) = data(i, 9)
            .Range("F" & i) = data(i, 10)

            If i > 1 Then
                .Range("B" & i) = IIf(data(i, 1) <> "", data(i, 1), .Range("B" & i - 1))
            Else
                .Range("B" & i) = data(i, 1)
            End If

            For j = 2 To 7
                If data(i, j) = "x" Then
                    .Range("C" & i) = "Level" & j - 1
                End If
            Next j

        End With
    Next i 
End Sub

答案 2 :(得分:0)

您可以使用 Power Query Excel 2010+轻松下载和激活,或者在2016版本中默认激活。在那里,您可以转换数据并将其作为表或数据透视表: