Copiar para colunas...
 
Notifications
Clear all

Copiar para colunas não sequenciais

5 Posts
2 Usuários
0 Likes
984 Visualizações
(@adrandre)
Posts: 3
New Member
Topic starter
 

Bom dia, tenho duas tabelas 1 ( Lançamento MAP) e tabela 2 ( Base DATA), na tabela 1 tenho apenas uma linha com umas 70 colunas onde é digitado os dados para uma data especifica, a tabela 2 deve receber esses dados, ela contém todas as datas do ano e umas 130 colunas, sendo as 70 que combinam mais algumas no meio com várias fórmulas.

Meu problema é o seguinte, não consigo um código que encontre a data correta na tabela 2, e copie a informação nas colunas idênticas, o mais perto que achei foi esse abaixo que cola na data correta, mas vai sequencial.

 

Exemplo das colunas nas duas tabelas em anexo, vermelho tabela 1, azul tabela 2.

 

Agradeço a ajuda, já me falaram para usar Find ou Application.Match mas não sei como.

 

Sub NewNameandCostCenter()

  Dim start As Double
  start = Timer

  Dim countOfChangedRows As Long

  'set rngMap array
  Dim rngMap As Range
  Set rngMap = Worksheets("Lançamento captação").Range("A3:g4")

  'set rngData array
  Dim rngData As Range
  Set rngData = Worksheets("Base balanço Hídrico").Range("a6:k800")

  Dim aMap As Variant
  aMap = rngMap.Value

  Dim aData As Variant
  aData = rngData.Value

  Dim mapRow As Long
  Dim datarow As Long
  Dim mapcol As Long

  For mapRow = LBound(aMap, 1) To UBound(aMap, 1)
    For datarow = LBound(aData) To UBound(aData)
      'Check the key matches in both tables
      If aData(datarow, 1) = aMap(mapRow, 1) Then
        countOfChangedRows = countOfChangedRows + 1
        'Assumes the columns in map and data match
        For mapcol = LBound(aMap, 2) + 1 To UBound(aMap, 2)
          aData(datarow, mapcol) = aMap(mapRow, mapcol)
        Next mapcol
      End If
    Next datarow
  Next mapRow

  rngData.Value = aData

  Debug.Print countOfChangedRows & " of "; UBound(aData, 1) & " rows updated in " & Timer - start & " seconds"

End Sub
 
Postado : 16/02/2021 8:06 am
Tags do Tópico
EdsonBR
(@edsonbr)
Posts: 1056
Noble Member
 

 Bem vindo ao fórum Planilhando, @adrandre

 
Postado por: @adrandre

...um código que encontre a data correta na tabela 2, e copie a informação nas colunas idênticas...

Perguntas:

  • A data da tabela 1, de lançamento, sempre vai existir na tabela 2 ou às vezes precisará ser cadastrada?
  • E se existir, ela será única ou ocorrem duplicidades?
  • Todas as colunas da tabela 1 existem na 2 e todas têm o mesmo nome?
  • Melhor seria vc anexar um modelo aqui mesmo no fórum, mesmo que simplificado e com alguns dados já lançados, fictícios caso sejam confidenciais. Assim podemos trabalhar sobre ele sem ter que criar do zero.

 

 

 
Postado : 16/02/2021 10:08 am
(@adrandre)
Posts: 3
New Member
Topic starter
 

@edsonbr

  • A data da tabela 1, de lançamento, sempre vai existir na tabela 2 ou às vezes precisará ser cadastrada? 
  • Sim, a data sempre existirá na tabela 2
  • E se existir, ela será única ou ocorrem duplicidades?
  • única
  • Todas as colunas da tabela 1 existem na 2 e todas têm o mesmo nome?
  • sim todas teram o mesmo nome
  • Melhor seria vc anexar um modelo aqui mesmo no fórum, mesmo que simplificado e com alguns dados já lançados, fictícios caso sejam confidenciais. Assim podemos trabalhar sobre ele sem ter que criar do zero.
  • em anexo, não esta com todas as 100 colunas ainda mas o esquema esta completo,  obrigado pela ajuda
 
Postado : 16/02/2021 12:07 pm
EdsonBR
(@edsonbr)
Posts: 1056
Noble Member
 
Postado por: @adrandre

 

  • Todas as colunas da tabela 1 existem na 2 e todas têm o mesmo nome?
  • sim todas teram o mesmo nome

 

Atenção porque essa premissa não está sendo atendida de maneira rigorosa, portanto peço que revise os cabeçalhos das colunas procurando principalmente por espaços em branco sobrando após o texto. Esse é um vício comum de digitação que infelizmente (ou felizmente) o Excel não perdoa. Por exemplo, já na coluna DATA, há um desses espaços sobrando (tabela de lançamentos). Idem para o campo MÊS, mas aí está sobrando em ambas as tabelas (lançamento e Base).

Como o Excel considera que "DATA" é diferente de "DATA ", dará erro ao rodar o código, portanto deve ser retificado antes. Para o caso da coluna MÊS, embora não gere erro pois ambas estão com o mesmo erro mas iguais, convém normalizar para minimizar possíveis danos em futuras análises de dados.

Após retificar, teste o seguinte código:

Sub LançaDados()
   Dim rgLcto As Range, rgLinhaData As Range, c As Range
   Set rgLcto = Worksheets("Lançamento captação").Range("A3"): Set rgLcto = Range(rgLcto, rgLcto.End(xlToRight))
   Set rgLinhaData = Range("Base[DATA]").Find(What:=rgLcto.Cells(1).Offset(1).Value, LookAt:=xlWhole).EntireRow
   For Each c In rgLcto
    Intersect(rgLinhaData, Range("Base").ListObject.ListColumns(c.Value).DataBodyRange).Value = c.Offset(1).Value
   Next c
End Sub

 
Postado : 16/02/2021 3:08 pm
(@adrandre)
Posts: 3
New Member
Topic starter
 

Funcionou perfeito, agora vou trabalhar nas colunas a base antiga tem umas 100 colunas, vou deixar os nomes exatamente iguais, obrigado, vai me ajudar muito muito, nota 10!!

 
Postado : 16/02/2021 5:42 pm