Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 Imprimir listagem especifica

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
ze.gaspar



Mensagens : 2
Data de inscrição : 11/02/2015

MensagemAssunto: Imprimir listagem especifica   Qui Fev 12, 2015 1:07 pm


Estou a criar um ficheiro para uso por diversos utilizadores e com recurso aos controlos e formulários para ser mais simples de usar por aqueles que detém menos conhecimentos.

Ora para atingir este objetivo estou perante um problema ao qual não encontro saída e sem ideias de como o fazer. Por isso passo a descrever com um exemplo fictício para ver se algum me pode ajudar

Tenho um conjunto de registos e que pretendo listar para impressora mas não no formato de trabela tal como está mas num formato especifico, ou seja:


Tomando por base a seguinte tabela

Numero Utilizador Departamento
888 888 001 Nome A Comercial
888 888 005 Nome B Logístico
888 888 004 Nome C Comercial
888 888 006 Nome D Comercial
888 888 003 Nome E Gerência
888 888 002 Nome F Logístico


Pretendo listar na impressora neste formato

Departamento Comercial
Numero Utilizador
888 888 001 Nome A
888 888 004 Nome C
888 888 006 Nome D

Departamento Gerência
Numero Utilizador
888 888 003 Nome E

Departamento Logístico
Numero Utilizador
888 888 005 Nome B
888 888 002 Nome F

Desde já agradeço a ajuda que for possível.

Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Imprimir listagem especifica   Sex Fev 13, 2015 7:29 pm

Boa tarde!!

Tente algo assim.
Código:
Sub AleVBA_988()
Dim Rng As Range, Dn As Range, c As Long
Set Rng = Range(Range("d2"), Range("d" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 2, 1 To 3)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .exists(Dn.Value) Then
        .Add (Dn.Value), Dn
    Else
        Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    End If
Next
Dim k As Variant, G As Range
For Each k In .keys
    c = c + 1
    Ray(c, 1) = "Departmento" & " " & k
    c = c + 1: Ray(c, 1) = "Numero": Ray(c, 2) = "User": Ray(c, 3) = "Nome"
For Each G In .Item(k)
    c = c + 1
    Ray(c, 1) = G.Offset(, -3).Value: Ray(c, 2) = G.Offset(, -2).Value: Ray(c, 3) = G.Offset(, -1).Value
Next G
Next k
Range("F1").Resize(c, 3) = Ray
End With

Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
ze.gaspar



Mensagens : 2
Data de inscrição : 11/02/2015

MensagemAssunto: Re: Imprimir listagem especifica   Seg Fev 16, 2015 1:23 pm

Bom dia,

Muito obrigado, grande ajuda mesmo!
Já experimentei e funciona na perfeição

Cpts




alexandrevba escreveu:
Boa tarde!!

Tente algo assim.
Código:
Sub AleVBA_988()
Dim Rng As Range, Dn As Range, c As Long
Set Rng = Range(Range("d2"), Range("d" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 2, 1 To 3)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .exists(Dn.Value) Then
        .Add (Dn.Value), Dn
    Else
        Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    End If
Next
Dim k As Variant, G As Range
For Each k In .keys
    c = c + 1
    Ray(c, 1) = "Departmento" & " " & k
    c = c + 1: Ray(c, 1) = "Numero": Ray(c, 2) = "User": Ray(c, 3) = "Nome"
For Each G In .Item(k)
    c = c + 1
    Ray(c, 1) = G.Offset(, -3).Value: Ray(c, 2) = G.Offset(, -2).Value: Ray(c, 3) = G.Offset(, -1).Value
Next G
Next k
Range("F1").Resize(c, 3) = Ray
End With

Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Imprimir listagem especifica   Seg Fev 16, 2015 3:03 pm

Bom dia!

Eu fico feliz em ajudar, obrigado pelo retorno!


Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Conteúdo patrocinado




MensagemAssunto: Re: Imprimir listagem especifica   Hoje à(s) 5:44 pm

Voltar ao Topo Ir em baixo
 
Imprimir listagem especifica
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» Imprimir via wireless s8500
» Foto especifica para os novos membros
» Como personalizar a css de uma página especifica?
» Como fazer meu fórum mudar de visual numa data especifica
» Personalização especifica em fundo de tópico

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: