Usuário com melhor resposta
VBA Excel - procurar por um critério e copiar 2 células correspondentes a esse critério (linha)
Pergunta
-
Bom dia,
Precisava de saber se é possível fazer uma macro para o seguinte:
A tabela 1 está sheet1; a tabela 2está na sheet2 e a tabela 3 está na sheet3.
O que precisava era de um código que procurasse a informação nas tabelas 1 e 2 colocasse na tabela 3 como exemplificado.
Desde já agradeço a Vossa ajuda.
Tabela 1
Source Destiny total A L -10 A M -12 A N -2 B O -3 C P -5 D Q -4 E R -1 F S -1 F T -2 Tabela 2
Destiny Source total A L 21 B M 12 C N 5 D O 4 E P 1 F Q 3 G R 3 H S 3 H T 3 Tabela 3
S & D A L -10 M -12 N -2 L 21 B O -3 M 12 C P -5 N 5 D Q -4 O 4 E R -1 P 1 F S -1 T -2 Q 3 G R 3 H S 3 I T 3 J K
Respostas
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else Dim LINHA4 As Long Dim ACHOU As Boolean ACHOU = False LINHA4 = 2 While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 4) <> "" If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHOU = True End If LINHA4 = LINHA4 + 1 Wend If ACHOU = True Then linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 Dim ACHADO As Boolean ACHADO = False While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" And ACHADO = False If ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHADO = True col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If linha3 = linha3 + 1 Wend If ACHADO = False Then ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If End If End If linha = linha + 1 Wend ThisWorkbook.Sheets("sheet3").Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, 4)) Then soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) End If col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End SubAnderson Diniz
- Sugerido como Resposta AndersonFDiniz2 quinta-feira, 7 de setembro de 2017 02:47
- Marcado como Resposta R principiante terça-feira, 12 de setembro de 2017 17:54
Todas as Respostas
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long linha = 2 Sheets("sheet3").Cells.Clear While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If If linha > 2 Then linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" linha2 = linha2 + 1 Wend If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend End SubAnderson Diniz
- Sugerido como Resposta AndersonFDiniz2 domingo, 3 de setembro de 2017 22:58
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long linha = 2 Sheets("sheet3").Cells.Clear While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If If linha > 2 Then linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" linha2 = linha2 + 1 Wend If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend End Sub
Anderson Diniz
Anderson,
Muito obrigada pela resposta. Que grande ajuda!!!
Gostei muito da sua forma. Achei que tinha que colocar a informação da primeira linha para conseguir fazer um ciclo. No entanto, estive a simular com o exemplo que dei e só funcionou para a primeira letra (A).
Será que me consegue ajudar no passo seguinte?
E, uma vez que eu pensei noutra forma, acha que é possível na sheet3, na coluna B / coluna 2, obter o somatório dos valores para cada linha?
Tabela 3 S & D sum A -3 L -10 M -12 N -2 L 21 B 9 O -3 M 12 C 0 P -5 N 5 D 0 Q -4 O 4 E 0 R -1 P 1 F 0 S -1 T -2 Q 3 G 3 R 3 H 3 S 3 I 3 T 3 Obrigadíssima pela ajuda!
Aproveito para pedir desculpa pelo atraso da resposta mas achei que receberia um alerta.
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If linha = linha + 1 Wend Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End SubAnderson Diniz
- Sugerido como Resposta AndersonFDiniz2 quarta-feira, 6 de setembro de 2017 16:27
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If linha = linha + 1 Wend Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End Sub
Anderson Diniz
Anderson,
Obrigadíssima! Está muito bom!
A única coisa que não está a captar são as letras "Destiny" que não há na sheet1 (Tabela 2 - sheet 2).
Fica assim:
S & D Sum A -3 L -10 M -12 N -2 L 21 B 9 O -3 M 12 C 0 P -5 N 5 D 0 Q -4 O 4 E 0 R -1 P 1 F -3 S -1 T -2 T 0 3 Falta apenas entender isto da tabela 2.
G R 3 H S 3 H T 3 Peço desculpa pelo pedido mas infelizmente não sei programar isto e preciso de encontrar dados de muitas linhas.
Mais uma vez obrigada!
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else Dim LINHA4 As Long Dim ACHOU As Boolean ACHOU = False LINHA4 = 2 While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) <> "" If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHOU = True End If LINHA4 = LINHA4 + 1 Wend If ACHOU = True Then linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If End If linha = linha + 1 Wend Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End SubAnderson Diniz
- Sugerido como Resposta AndersonFDiniz2 quarta-feira, 6 de setembro de 2017 19:13
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else Dim LINHA4 As Long Dim ACHOU As Boolean ACHOU = False LINHA4 = 2 While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) <> "" If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHOU = True End If LINHA4 = LINHA4 + 1 Wend If ACHOU = True Then linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If End If linha = linha + 1 Wend Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End Sub
Anderson Diniz
Anderson,
A tabela 1 e a tabela 2 têm o último comum "F" e o resultado correspondente ao "F" da tabela 2 não aparece na linha certa mas sim na linha de baixo.
Há forma de contornar?
Obrigada!
S & D Sum A -3 L -10 M -12 N -2 L 21 B 9 O -3 M 12 C 0 P -5 N 5 D 0 Q -4 O 4 E 0 R -1 P 1 F -3 S -1 T -2 Q 0 3 G 3 R 3 H 3 S 3 H 3 T 3
-
Anderson,
Para eu perceber o código, é possível descrever alguns passos para a procura da informação e para a cópia na sheet3?
Com os meus conhecimentos básicos, apenas consigo entender alguns passos.
Muito obrigada pela GRANDE ajuda e pelo tempo dispensado comigo. Valeu mesmo!
-
Option Explicit Sub TESTE() Dim linha As Long Dim linha2 As Long Dim col As Long Dim linha3 As Long Sheets("sheet3").Cells.Clear linha = 2 While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> "" If linha = 2 Then ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) Else linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" linha3 = linha3 + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3) End If End If linha = linha + 1 Wend linha = 2 While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> "" If linha = 2 Then If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If Else linha2 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> "" linha2 = linha2 + 1 Wend 'linha2 = linha2 - 1 If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else Dim LINHA4 As Long Dim ACHOU As Boolean ACHOU = False LINHA4 = 2 While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 4) <> "" If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHOU = True End If LINHA4 = LINHA4 + 1 Wend If ACHOU = True Then linha3 = 2 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" linha3 = linha3 + 1 Wend col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) Else linha3 = 2 Dim ACHADO As Boolean ACHADO = False While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" And ACHADO = False If ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then ACHADO = True col = 1 While ThisWorkbook.Sheets("sheet3").Cells(linha3, col) <> "" col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If linha3 = linha3 + 1 Wend If ACHADO = False Then ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2) ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3) End If End If End If End If linha = linha + 1 Wend ThisWorkbook.Sheets("sheet3").Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D" ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum" linha = 2 Dim soma As Integer While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, 4)) Then soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4) End If col = 6 While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> "" If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value End If col = col + 1 Wend ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma linha = linha + 1 Wend End SubAnderson Diniz
- Sugerido como Resposta AndersonFDiniz2 quinta-feira, 7 de setembro de 2017 02:47
- Marcado como Resposta R principiante terça-feira, 12 de setembro de 2017 17:54
-
