Como dividir e manipular programaticamente linhas de dados do Excel

Question

Espero que um de vocês consiga me ajudar nessa questão. Eu preciso criar algum tipo de macro ou código VBA para dividir e manipular linhas de dados no Excel.

Para este exemplo, temos 5 linhas de dados. As primeiras 3 linhas são informações do item para o Pedido nº 0000000000-00 e as últimas 2 linhas são informações do item para o pedido nº 0000000000-01. Preciso de uma linha ("HDR") para cada número de pedido e uma linha ("ITM") para cada produto por pedido. Eu incluí um exemplo abaixo mostrando os dados que receberei e o resultado desejado.

Dados brutos:

order-id        product-num     date        buyer-name  product-name    quantity-purchased
0000000000-00   10000000000000  5/29/2014   John Doe    Product 0       1
0000000000-00   10000000000001  5/29/2014   John Doe    Product 1       2
0000000000-00   10000000000002  5/29/2014   John Doe    Product 2       1
0000000000-01   10000000000002  5/30/2014   Jane Doe    Product 2       1
0000000000-01   10000000000003  5/30/2014   Jane Doe    Product 3       1

Resultado desejado:

HDR 0000000000-00   John Doe    5/29/2014
ITM 10000000000000  Product 0   1
ITM 10000000000001  Product 1   2
ITM 10000000000002  Product 2   1
HDR 0000000000-01   Jane Doe    5/30/2014
ITM 10000000000002  Product 2   1
ITM 10000000000003  Product 3   1

Toda e qualquer ajuda seria muito apreciada !!! Obrigado.

    

Answer 1

Esta macro faz o que você quer, mas só é testada com os dados que você deu (embora se continuar da mesma maneira, deve ficar bem, o problema será se você adicionar mais colunas, mas o código deve realmente ser fácil de atualizar)

Sub SortMeOut()

Dim previousOrderId As String

Dim row As Integer
row = 2


previousOrderId = Worksheets("Sheet1").Range("A2").Value

Dim offset As Integer
offset = 0

Do While (True)

        If Worksheets("Sheet1").Range("A" & row).Value = "" Then
        Exit Do
        End If

    Dim isHeader As Boolean
    isHeader = True
    Do While (True) 'loop through all columns with a match

        If Worksheets("Sheet1").Range("A" & row).Value <> previousOrderId Then
        Exit Do
        End If

        If Not isHeader Then
           Worksheets("Sheet2").Range("A" & row + 1 + offset).Value = "ITM"
            Worksheets("Sheet2").Range("B" & row + 1 + offset).Value = Worksheets("Sheet1").Range("B" & row).Value ' product num
            Worksheets("Sheet2").Range("C" & row + 1 + offset).Value = Worksheets("Sheet1").Range("E" & row).Value ' product name
            Worksheets("Sheet2").Range("D" & row + 1 + offset).Value = Worksheets("Sheet1").Range("F" & row).Value ' quantity
            End If


        If isHeader Then
            Worksheets("Sheet2").Range("A" & row + offset).Value = "HDR"
            Worksheets("Sheet2").Range("B" & row + offset).Value = Worksheets("Sheet1").Range("A" & row).Value 'order id
            Worksheets("Sheet2").Range("C" & row + offset).Value = Worksheets("Sheet1").Range("D" & row).Value ' name of the dude
            Worksheets("Sheet2").Range("D" & row + offset).Value = Worksheets("Sheet1").Range("C" & row).Value ' date

            'we also have to do the first item as well...
             Worksheets("Sheet2").Range("A" & row + 1 + offset).Value = "ITM"
            Worksheets("Sheet2").Range("B" & row + 1 + offset).Value = Worksheets("Sheet1").Range("B" & row).Value ' product num
            Worksheets("Sheet2").Range("C" & row + 1 + offset).Value = Worksheets("Sheet1").Range("E" & row).Value ' product name
            Worksheets("Sheet2").Range("D" & row + 1 + offset).Value = Worksheets("Sheet1").Range("F" & row).Value ' quantity
            isHeader = False
        End If

      row = row + 1

    Loop

offset = offset + 1
previousOrderId = Worksheets("Sheet1").Range("A" & row).Value


Loop

End Sub

Ele assume que os dados estão no workseet1 e envia os resultados para worksheet2

Antes

Depois