Este fórum está sendo desativado

[xmiguelx]

Boa tarde pessoal!

Preciso de mais uma ajuda!

Recentemente nosso amigo osvaldomp me ajudou em um problema que eu tinha para manter a lista de todos os produtos faturado sem repetir o código e na célula ao lado, todas as notas correspondente a esse código de produto.

Essa solução funcionou perfeitamente, porém tive que mudar as colunas de lugar e células, e á 4 dias estou tentando ajustar para funcionar e não estou conseguindo

Segue em anexo o Exemplo 2 que esta funcionando perfeitamente e o exemplo 3 que estou querendo fazer o mesmo que o exemplo 2.

Agradeço desde já.

[xmiguelx]

Caros Amigos!

Esqueci de informar o Post do nosso amigo osvaldomp que havia me ajudado da primeira vez!!!

Já tentei de todas as formas, e não consigo replicar para esse exemplo 3 que postei.

http://gurudoexcel.com/forum/viewtopic.php?f=12&t=7530

Abs

[osvaldomp]

... porém tive que mudar as colunas de lugar e células,...

Código: Selecionar todos

Sub Preencher()
 Dim m As String, k As Long, x As Long
  Application.ScreenUpdating = False
   Sheets.Add
   Sheets("NOTAS EMITIDAS").Range("D6:D" & Sheets("NOTAS EMITIDAS").Cells(Rows.Count, 4).End(3).Row).Copy [B3]
   Sheets("NOTAS EMITIDAS").Range("I6:I" & Sheets("NOTAS EMITIDAS").Cells(Rows.Count, 9).End(3).Row).Copy [A3]
   ActiveSheet.Range("A3:B" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
   Range("A3:B" & Cells(Rows.Count, 1).End(3).Row).Sort Key1:=[A3], Order1:=xlAscending, Header:=xlNo
    With Sheets("RESUMO")
     .Columns(2) = "": .Columns(20) = "": .[B4] = "PRODUTO": .[T4] = "NOTAS A COMPLEMENTAR"
      For k = 3 To Cells(Rows.Count, 1).End(3).Row
       x = Application.CountIf([A:A], Cells(k, 1))
        If x = 1 Then
         m = Cells(k, 2).Text
        Else: m = Join(Application.Transpose(Cells(k, 2).Resize(x)), " ; ")
        End If
     .Cells(Rows.Count, 2).End(3)(2) = Cells(k, 1)
     .Cells(Rows.Count, 20).End(3)(2).NumberFormat = "@": .Cells(Rows.Count, 20).End(3)(2) = m
       k = k + x - 1
      Next k
    End With
  Application.DisplayAlerts = False
  ActiveSheet.Delete
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

dicas:
1. você inseriu essas variáveis porém não as utilizou no código ~~~> Dim x1, x2, x3, i As Long (eu não as coloquei no código acima)
Se a sua ideia foi declarar x1, x2 e x3 como do tipo Long, o correto é ~~~> Dim x1 As Long, x2 As Long, x3 As Long, i As Long, pois da forma que você declarou, as variáveis são consideradas de tipo não declarado e nesses casos o VBA as assume como do tipo Variant; das quatro variáveis que você declarou somente a variável "i" é do tipo Long
2. você adicionou ao código comando para formatar as células da coluna T da planilha RESUMO (eu não coloquei no código acima). Você pode formatar o intervalo manualmente apenas uma vez, pois o código que passei não altera a formatação, então não faz sentido a cada vez que rodar o código formatar o que já está formatado
3. alterei o texto que vai em T4 de "NOTAS Á COMPLEMENTAR" para "NOTAS A COMPLEMENTAR"

[xmiguelx]

Osvaldo,
Muito obrigado por ajudar novamente, funcionou perfeitamente.

Grato pelas dicas.

Abs