Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Classificação perso...
 
Notifications
Clear all

Classificação personalizada erro fecha e corrompe o arquivo

 
2024 - VBA & Macros
Post Recente por MPrudencio 6 anos atrás
7 Posts
3 Usuários
0 Reactions
1,352 Visualizações
RSS
 Creuza
(@creuza)
Posts: 0
New Member
Topic starter
 

Prezados

Na minha busca por uma macro que possibilitasse uma classificação personalizada na planilha
(preciso classificar a ordem dos setores de acordo com a loja) consegui desenvolver a seguinte macro 

Dim Loja As String
Dim setorOrdem As Integer
Dim EOrdem As Integer
Dim semOrdem As Integer
Dim Ulin As Long
Dim Planilha As Worksheet
Dim Intervalo As Range
    Ulin = Sheets("RelModelo").Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
    Loja = ActiveWorkbook.Worksheets("RelModelo").Range("AN1")
       
    Application.AddCustomList ListArray:=Array("SEG", "TER", "QUA", "QUI", "SEX", "Não")
    semOrdem = Application.GetCustomListNum(Array("SEG", "TER", "QUA", "QUI", "SEX", "Não"))
       
    Application.AddCustomList ListArray:=Array("J0", "J1", "J2", "J3", "J4", "J5", "J6", "J7", "J8", "J9", "J11", "J12", "1a", "2a", "3a", "4a", "5a", "6a", "7a", "8a", "9a", "4b", "A8", "A13", "A15", "C1", "C2", "C3")
    EOrdem = Application.GetCustomListNum(Array("J0", "J1", "J2", "J3", "J4", "J5", "J6", "J7", "J8", "J9", "J11", "J12", "1a", "2a", "3a", "4a", "5a", "6a", "7a", "8a", "9a", "4b", "A8", "A13", "A15", "C1", "C2", "C3"))
       
    ActiveWorkbook.Worksheets("Controles").Select
    With ActiveWorkbook.Worksheets("Controles")
   
    Select Case Loja
    
        Case "Paraiso"
            Application.AddCustomList ListArray:=Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA", "BOCA DE CAIXA TOTAL", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "APOIO(N)", "APOIO(N) TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL")
            setorOrdem = Application.GetCustomListNum(Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA", "BOCA DE CAIXA TOTAL", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "APOIO(N)", "APOIO(N) TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL"))
        Case "Trindade"
            Application.AddCustomList ListArray:=Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA TOTAL", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "APOIO(N) TOTAL", "APOIO(N)", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "ESTACIONAMENTO", "ESTACIONAMENTO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL")
            setorOrdem = Application.GetCustomListNum(Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA TOTAL", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "APOIO(N) TOTAL", "APOIO(N)", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "ESTACIONAMENTO", "ESTACIONAMENTO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL"))
        Case "Itaipú"
            Application.AddCustomList ListArray:=Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "APOIO(N)", "APOIO(N) TOTAL", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "HORTI FRUTI", "HORTI FRUTI TOTAL", "LIMPEZA", "LIMPEZA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "ESTACIONAMENTO", "ESTACIONAMENTO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL", "PREVENÇÃO E PERDAS", "PREVENÇÃO E PERDAS TOTAL", "PROPAGANDA / MKTG", "PROPAGANDA / MKTG TOTAL", "SELF CCKOUT", "SELF CCKOUT TOTAL", "VINHOS", "VINHOS TOTAL")
            setorOrdem = Application.GetCustomListNum(Array("CAIXA", "CAIXA TOTAL", "FISCAL", "FISCAL TOTAL", "BOCA DE CAIXA", "BOCA DE CAIXA", "ENTREGAS", "ENTREGAS TOTAL", "APOIO", "APOIO TOTAL", "APOIO(N)", "APOIO(N) TOTAL", "SALÃO", "SALÃO TOTAL", "AÇOUGUE", "AÇOUGUE TOTAL", "SALGADO", "SALGADO TOTAL", "LATICÍNIO", "LATICÍNIO TOTAL", "PADARIA", "PADARIA TOTAL", "QUITANDA", "QUITANDA TOTAL", "HORTI FRUTI", "HORTI FRUTI TOTAL", "LIMPEZA", "LIMPEZA TOTAL", "DEPÓSITO", "DEPÓSITO TOTAL", "DIVULGAÇÃO", "DIVULGAÇÃO TOTAL", "ESTACIONAMENTO", "ESTACIONAMENTO TOTAL", "OBRAS", "OBRAS TOTAL", "TRANSPORTES", "TRANSPORTES TOTAL", "ADMINISTRAÇÃO", "ADMINISTRAÇÃO TOTAL", "APRENDIZ", "APRENDIZ TOTAL", "PREVENÇÃO E PERDAS", "PREVENÇÃO E PERDAS TOTAL", "PROPAGANDA / MKTG", "PROPAGANDA / MKTG TOTAL", "SELF CCKOUT", "SELF CCKOUT TOTAL", "VINHOS", "VINHOS TOTAL"))
        
    End Select
    
   End With
   
     
    Set Planilha = ActiveWorkbook.Worksheets("RelModelo")
    Set Intervalo = Range("A4:Ak" & Ulin)
  
  'ordena os setores de acordo com a loja
   Planilha.Sort.SortFields.Clear
   Planilha.Sort.SortFields.Add Key:=Range("A4"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=setorOrdem, DataOption:=xlSortNormal
        
    With Planilha.Sort
        .SetRange Range("A4:Ak" & Ulin)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'ordena as equipes
           Planilha.Sort.SortFields.Add Key:=Range("D4"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=EOrdem, DataOption:=xlSortNormal
                    With Planilha.Sort
                            .SetRange Range("A4:Ak" & Ulin)
                            .Header = xlYes
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply
                        End With
            
    'ordena pelo dia da semana
                    Planilha.Sort.SortFields.Add Key:=Range("e4"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=semOrdem, DataOption:=xlSortNormal
                    With Planilha.Sort
                            .SetRange Range("A4:Ak" & Ulin)
                            .Header = xlYes
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply
                        End With
              
    Application.DeleteCustomList setorOrdem
    Application.DeleteCustomList EOrdem
    Application.DeleteCustomList semOrdem
End Sub

Daí que ela roda e não sei nem como, nem porque, o arquivo fecha e quando o Excel reabre e aparece a mensagem
O Excel encontrou conteúdo ilegível ... deseja reparar?
A pasta não pode ser reparada pelo MSEsexcel pq está corrompida.

Estou usando Excel 2010. 32 bits versão (14.0.7208.5000)

Alguém teria condições de me dizer o que está acontecendo e como contornar esse problema? esta macro é fundamental para meu projeto e muito provavelmente vai ser usada em uma versão 2007 do Excel. E só falta isso para finalizar.

Desde já agradeço a atenção

 
Postado : 02/07/2018 10:04 am
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Nao olhei a planilha mas se é apenas classificar o gravador de macros nao resolveria?

 
Postado : 02/07/2018 10:53 am
 Creuza
(@creuza)
Posts: 0
New Member
Topic starter
 

MPrudencio obrigada pela resposta, mas não, porque se a loja é A, a ordem dos setores é uma , se a loja é B a ordem dos setores é outra e se a loja é C e diferente das duas anteriores, por isso usei o select case. Entende?

o gravador de macros nao me ajudou neste sentido não.

Peguei essa ideia do livro Excel 2016 Macros e VBA e a segunda parte da macro eu literalmente copiei da página 273 deste livro!

obrigada pela atenção

 
Postado : 02/07/2018 12:21 pm
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Creuza,

Boa tarde!

Bem complexo seu arquivo e seu código. Confesso que não me detive a entender tudo o que ele faz mas... o que é importante é que rodei aqui normalmente e os problemas relatados por você não ocorreram aqui. Uso o Excel 2007 de 32 Bits em um Windows de 64 Bits. Na primeira execução do seu código ocorreu apenas um erro quase no fim do código em razão de que o comando Application.DeleteCustomList setorOrdem não encontrava nada em setorOrdem. Verifiquei então que o seu código estava atribuindo a variável Loja um valor que não existe nesse arquivo que você enviou (Loja = ActiveWorkbook.Worksheets("RelModelo").Range("AN1")) . Nesse arquivo, o nome da loja está na célula B1. Assim, alterei apenas isso e o código funcionou normalmente.

 
Postado : 02/07/2018 1:53 pm
 Creuza
(@creuza)
Posts: 0
New Member
Topic starter
 

Wagner obrigada pela ajuda.
Já acertei este equivoco.
Será que era essa a causa do problema de fechar e corromper o arquivo?

 
Postado : 02/07/2018 5:43 pm
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Creuza,

Boa noite!

Creio que não, mas... não sei o que pode ter sido!

 
Postado : 02/07/2018 6:03 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Entendo que sao varias lojas e cada uma tem uma particularidade.

Minha Sugestão:

Fazer a gravaçao com o gravador de macros em cada loja e depois juntar o codigo com select case vc diz ter feito.

Mas primeiro teste a solução do Wagner pode ser que resolva.

PS Não olhei seu arquivo.

 
Postado : 03/07/2018 11:42 am
Forum Jump:
  Tópico Anterior
Próximo Tópico