Excel: clona uma lista para cada valor único em uma lista diferente

2

Eu tenho duas tabelas table1: lista de IDs exclusivos (o tamanho da lista é 3) e table2: lista de itens (o tamanho da lista é 3).

Como eu poderia criar uma terceira lista em que, para cada linha da tabela 1, ela adicionasse todas as linhas da tabela2 ao ID exclusivo. Então, usando os números de exemplo acima, devemos terminar com 9 linhas, 3 linhas para cada id único da tabela 1.

Espero que faça sentido, também espero que o abaixo seja legível!

Tabela 1:

UID Header
UID1
UID2
UID3

Tabela 2:

Header1      Header2
Name1        Value1       
Name2        Value2
Name3        Value3

Resultado esperado:

UIDH    Header1      Header2
UID1    Name1        Value1       
UID1    Name2        Value2
UID1    Name3        Value3
UID2    Name1        Value1       
UID2    Name2        Value2
UID2    Name3        Value3
UID3    Name1        Value1       
UID3    Name2        Value2
UID3    Name3        Value3
    
por Jeff 02.04.2015 / 12:04

1 resposta

0

Isso faz exatamente o que você pediu

Option Explicit
Sub OoohEckPirates()

Dim table1Start As Integer
table1Start = 2                     ' UPDATE ME

Dim table2Start As Integer
table2Start = 7                     ' UPDATE ME

Dim resultsTableStart As Integer
resultsTableStart = 12              ' UPDATE ME


'Create the header
Range("A11").Value = "UID Header"   ' UPDATE ME
Range("B11").Value = "Name Header"  ' UPDATE ME
Range("C11").Value = "Value Header" ' UPDATE ME 

Dim header1Row As Integer
Dim header2Row As Integer
Dim resultsRow As Integer

Dim col  As Integer
col = 65                             'UPDATE ME - 65 = A, 66 = B, 67 = C. So, if your first column is A, set it to 65

Dim currentUid As String

header1Row = table1Start
resultsRow = resultsTableStart
Do While (Range("A" & header1Row).Value <> "")
    currentUid = Range("A" & header1Row).Value
    header2Row = table2Start

    Do While (Range(Chr(col) & header2Row).Value <> "")
            Range(Chr(col) & resultsRow).Value = currentUid
            Do While (Range(Chr(col) & header2Row).Value <> "")

                 Range(Chr(col + 1) & resultsRow).Value = Range(Chr(col) & header2Row).Value
                 col = col + 1
            Loop
    col = 65
    header2Row = header2Row + 1
    resultsRow = resultsRow + 1
    Loop


    header1Row = header1Row + 1
Loop

End Sub

Antes de executá-lo, faça um backup, só para ter certeza

Como eu adiciono o VBA no MS Office?

Antes

Depois

    
por 02.04.2015 / 13:50