- 16 Fev 2024 às 16:01
#74094
Seguem 3 opções que retornam resultados iguais.
_____________________________________________________________________________________________________
Sub ConCatEval() 'insere direto os resultados na coluna A via Evaluate, mas em seguida é preciso formatar as datas
Dim r As Range
Application.ScreenUpdating = False
If [A2] <> "" Then Range("A2:C" & Cells(Rows.Count, 1).End(3).Row).Value = ""
With Range("A2:A" & Cells(Rows.Count, 27).End(3).Row)
.Value = Evaluate(.Offset(, 28).Address & "& "" - "" & " & .Offset(, 27).Address & "& "" - "" & " & .Offset(, 26).Address)
End With
For Each r In Range("A2:A" & Cells(Rows.Count, 27).End(3).Row)
r.Value = Format(Left(r.Value, 5), "dd/mm/yyyy") & Right(r.Value, Len(r.Value) - 5)
Next r
Range("AD2:AE" & Cells(Rows.Count, 27).End(3).Row).Copy [B2]
End Sub
_____________________________________________________________________________________________________
Sub ConCatForm() 'insere fórmulas na coluna A e em seguida substitui pelos respectivos valores
Application.ScreenUpdating = False
If [A2] <> "" Then Range("A2:C" & Cells(Rows.Count, 1).End(3).Row).Value = ""
With Range("A2:A" & Cells(Rows.Count, 27).End(3).Row)
.Formula = "=TEXT(AC2,""dd/mm/aaaa"")&"" - ""&AB2&"" - ""&AA2"
.Value = .Value
End With
Range("AD2:AE" & Cells(Rows.Count, 27).End(3).Row).Copy [B2]
End Sub
_____________________________________________________________________________________________________
Sub ConCatLoop() 'Loop na coluna A para inserir os resultados
Dim LR As Long, k As Long
Application.ScreenUpdating = False
If [A2] <> "" Then Range("A2:C" & Cells(Rows.Count, 1).End(3).Row).Value = ""
LR = Cells(Rows.Count, 27).End(3).Row
For k = 2 To LR
Cells(k, 1) = Format(Cells(k, 29).Value, "mm/dd/yyyy") & " - " & Cells(k, 28) & " - " & Cells(k, 27)
Next k
Range("AD2:AE" & Cells(Rows.Count, 27).End(3).Row).Copy [B2]
End Sub
_____________________________________________________________________________________________________
dica - para responder clique em +Resposta, localizada abaixo da última postagem; só clique em Responder com Citação se necessário
Osvaldo
Quatro coisas que odeio: preguiçosos, políticos, Google planilhas e Outlook
Anexe arquivos diretamente no fórum:
+ Resposta / Adicionar um anexo / Selecione o arquivo
CÉLULAS MESCLADAS PODEM AFETAR FÓRMULAS E MACROS.