Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Separar dados usand...
 
Notifications
Clear all

Separar dados usando condição

 
2024 - VBA & Macros
Post Recente por DJunqueira 8 anos atrás
9 Posts
3 Usuários
0 Reactions
1,474 Visualizações
RSS
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

Olá, preciso de ajuda para separar dados da planilha em anexo:

Funcionamento da planilha:

Dados iniciais estão na planilha XML Estofafo.
- ao abrir botão de controle carrega listview com os dados a serem processados,
- ao clicar no botão exportar os dados são separados usando como condição a coluna D da planilha XML Estofado (separando por nome de cliente).

Até ai conseguimos com a ajuda de alguns amidos aqui do Planilhando.

Agora preciso que:
- seja inserida uma nova condição para separar os dados e copiar para as planilhas dos clientes os dados apenas se na colula AF (Modalidade do Frete) exista o numero 0 (zero), caso exista o numero 1 (um) preciso que seja copiado para a planilha FRETE FOB mesmo que seja dos tres clientes misturados (não importando misturar os cliente nessa planilha).

pois preciso cobrar dos clientes apenas o que contiver o numero 1 na coluna AF e a outra separação continue para controle.

Não sei se fui claro mas preciso de ajuda.

Segue a planilha anexa

Obrigado

 
Postado : 12/10/2016 4:24 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Eu nao consegui identificar quais as colunas devem ser copiadas

 
Postado : 12/10/2016 5:18 pm
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

as colunas a serem copiadas são apenas algumas da planilha do XML, não mapeei com menos dados os XMLs pois posso usar os dados no futuro, então tem colunas com dados sobrando que servirão no futuro.

o código é esse:

Private Sub CommandButton1_Click()

Dim Cliente(2) As String
Cliente(0) = "Oliveira"
Cliente(1) = "Maciel"
Cliente(2) = "Solar"
Sheets("xml estofado").Select
nreg = Sheets("xml estofado").Cells(Cells.Rows.Count, "D").End(xlUp).ROW
lin = 2
For x = 0 To 2

    For lin = 2 To nreg
        If UCase(Sheets("xml estofado").Cells(lin, 4)) Like UCase("*" & Cliente(x) & "*") Then
            If Sheets("xml estofado").Cells(lin, 34) = "copiado" Then
            Else
                Sheets("xml estofado").Cells(lin, 2).Copy Destination:=Sheets("planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(1, 0)
                Sheets("xml estofado").Cells(lin, 29).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 3)
                Sheets("xml estofado").Cells(lin, 4).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 4)
                Sheets("xml estofado").Cells(lin, 14).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 5)
                Sheets("xml estofado").Cells(lin, 18).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 6)
                Sheets("xml estofado").Cells(lin, 19).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 7)
                Sheets("xml estofado").Cells(lin, 30).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 8)
                Sheets("xml estofado").Cells(lin, 31).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 9)
                Sheets("xml estofado").Cells(lin, 1).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 10)
                Sheets("xml estofado").Cells(lin, 32).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 11)
                Sheets("xml estofado").Cells(lin, 35).Value = Date
                Sheets("xml estofado").Cells(lin, 35).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 1)
                Sheets("xml estofado").Cells(lin, 34) = "copiado"
            End If
Next
 
Postado : 12/10/2016 6:25 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

E só vc indicar quais colunas devem ser copiadas

 
Postado : 13/10/2016 3:21 am
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

OK da planilha XML Estofado na seguinte ordem:

B, AC, D, N, R, S, AD, AE, AF

obrigado

 
Postado : 13/10/2016 7:46 am
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

Boa noite galera,

esse meu caso é tão difícil assim ?

 
Postado : 15/10/2016 4:08 pm
 DJunqueira
(@djunqueira)
Posts: 0
New Member
 

Se a sua versão do Excel é a 2013 ou superior o ideal seria importar por Nova Consulta / Power Query e depois separar em quantas formas quiser e do jeito q quiser.
Na planilha anexa separei como desejado com Nova Consulta, em caso de acréscimo de novos dados clique no botão Atualizar tudo em Dados.

 
Postado : 15/10/2016 5:33 pm
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

[RESOLVIDO]

Galera resolvi o problema lendo e relendo muito aqui no forum, a resolução veio de forma simples .

peguei o código Já formulado por nosso Amigo Reinaldo e após executá-lo criei outro módulo um para cada cliente e adicionei a condição da célula 12 (L) a qual existia a condição 0 ou 1. o código ficou assim:

Dim Cliente(2) As String
Cliente(0) = "Oliveira"
Cliente(1) = "Maciel"
Cliente(2) = "Solar"
Sheets("xml estofado").Select
nreg = Sheets("xml estofado").Cells(Cells.Rows.Count, "D").End(xlUp).ROW
lin = 2
For x = 0 To 2

    For lin = 2 To nreg
        If UCase(Sheets("xml estofado").Cells(lin, 4)) Like UCase("*" & Cliente(x) & "*") Then
            If Sheets("xml estofado").Cells(lin, 34) = "copiado" Then
            Else
                Sheets("xml estofado").Cells(lin, 2).Copy Destination:=Sheets("planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(1, 0)
                Sheets("xml estofado").Cells(lin, 29).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 3)
                Sheets("xml estofado").Cells(lin, 4).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 4)
                Sheets("xml estofado").Cells(lin, 14).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 5)
                Sheets("xml estofado").Cells(lin, 18).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 6)
                Sheets("xml estofado").Cells(lin, 19).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 7)
                Sheets("xml estofado").Cells(lin, 30).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 8)
                Sheets("xml estofado").Cells(lin, 31).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 9)
                Sheets("xml estofado").Cells(lin, 1).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 10)
                Sheets("xml estofado").Cells(lin, 32).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 11)
                Sheets("xml estofado").Cells(lin, 35).Value = Date
                Sheets("xml estofado").Cells(lin, 35).Copy Destination:=Sheets("Planilha " & Cliente(x)).Range("A1048576").End(xlUp).Offset(0, 1)
                Sheets("xml estofado").Cells(lin, 34) = "copiado"
            End If
        End If
     
    Next
Next

fob_oliveira
 fob_maciel
 fob_solar

onde cada macro desta está com este código alterado somente o nome do cliente e da planilha:

Dim Cliente(2) As String
   
Cliente(0) = "0"
Cliente(1) = "1"
Sheets("Planilha Solar").Select
nreg = Sheets("Planilha Solar").Cells(Cells.Rows.Count, "L").End(xlUp).ROW
lin = 2
For x = 0 To 1

    For lin = 2 To nreg
        If UCase(Sheets("Planilha Solar").Cells(lin, 12)) Like UCase("*" & Cliente(x) & "*") Then
             If Sheets("Planilha Solar").Cells(lin, 12) = "0" Then
            Else
                Sheets("Planilha Solar").Cells(lin, 1).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(1, 0)
                Sheets("Planilha Solar").Cells(lin, 2).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 1)
                Sheets("Planilha Solar").Cells(lin, 3).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 2)
                Sheets("Planilha Solar").Cells(lin, 4).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 3)
                Sheets("Planilha Solar").Cells(lin, 5).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 4)
                Sheets("Planilha Solar").Cells(lin, 6).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 5)
                Sheets("Planilha Solar").Cells(lin, 7).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 6)
                Sheets("Planilha Solar").Cells(lin, 8).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 7)
                Sheets("Planilha Solar").Cells(lin, 9).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 8)
                Sheets("Planilha Solar").Cells(lin, 10).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 9)
                Sheets("Planilha Solar").Cells(lin, 11).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 10)
                Sheets("Planilha Solar").Cells(lin, 12).Cut Destination:=Sheets("FRETE FOB").Range("A1048576").End(xlUp).Offset(0, 11)
                Sheets("Planilha Solar").Cells(lin, 1).Select
                apagar_linha_ok   ' Selection.EntireRow.Delete
                
              End If
          End If
    Next
Next

End Sub

Valew a grande abrass

 
Postado : 15/10/2016 5:40 pm
 DJunqueira
(@djunqueira)
Posts: 0
New Member
 

Faltou anexar a planilha...

 
Postado : 15/10/2016 5:43 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico