Jump to content
vbalexandre

Erro ao FormatarDuplicidades

Recommended Posts

vbalexandre

Olá pessoal...

Venho novamente solicitar uma ajuda.

O Edouardo da ultima vez me ajudou enviando um código  que me ajudou bastante.

Agora eu preciso executar esse código com 500 linhas, se tento alterar ocorre um erro....

No arquivo tem mais informação.

http://www.4shared.com/file/gX4k3BX2/Formatar_Duplicidades.html

Caso algo dê errado com o link me retorne.

Desde já agradeço.

Att..

Share this post


Link to post
Share on other sites
Andrepereira9

boas

alterei o Lrows para 500 e

acrescentei isto no código  e funcionou

Parece que quando o scor, chega ao 60, já nao existem mais cores disponiveis. entao, pu-los a começar do 1 novamente

if sCor = 59 Then
sCor = 1
End If

Codigo final

Sub InteriorColorDuplicados()

    Dim LLoop As Integer
    Dim LTestLoop As Integer
    Dim LClearRange As String
    
    Dim Lrows As Integer
    Dim LRange As String
    
    'Variaveis para a Coluna e Valor
    Dim LChangedValue As String
    Dim LTestValue As String
    
    'Cor Inicial
    Dim sCor As Integer
    sCor = 1

    'Teste em 20 linhas na planilha
    Lrows = 500 'Atere aqui para mais Linhas
    LLoop = 2
    
    'Limpa a formatação anterior
    LClearRange = "C2:C" & Lrows
    Range(LClearRange).Interior.ColorIndex = xlNone
    
    'Verifica primeiro as 20 linhas na planilha
    While LLoop <= Lrows
        'Define a Coluna C
        LChangedValue = "C" & CStr(LLoop)
        
        If Len(Range(LChangedValue).Value) > 0 Then
        
            'Testa cada valor se são unicos
            LTestLoop = 2
            While LTestLoop <= Lrows
                If LLoop <> LTestLoop Then
                    LTestValue = "C" & CStr(LTestLoop)
                    'Se o valor for duplicado
                    If (Range(LChangedValue).Value = Range(LTestValue).Value) Then
                        'Altera a cor de Fundo da celula
                        Range(LChangedValue).Interior.ColorIndex = sCor
                        Range(LTestValue).Interior.ColorIndex = sCor
                    End If
                        
                End If
                
                LTestLoop = LTestLoop + 1
            Wend
            
        End If
        
        LLoop = LLoop + 1
   
        'Soma + 1 para a proxima Cor
        sCor = sCor + 1
    If sCor = 59 Then
    
      sCor = 1
         End If
    Wend
    
End Sub


A informática chegou para resolver problemas que antes não existiam

Quem ri por último é porque está conectado a 52 Kbs.

Share this post


Link to post
Share on other sites
vbalexandre

Boa noite!!!

Andrepereira9, obrigado pela atenção mas, testei e continua dando o erro'9' como havia descrito na planilha.

E também na coluna "C" "na linha 95" a remessa 045679000

não foi pintada, o que eu fiiz de errado?

Após o erro mostra de na depuração em amarelo:

Range(LChangedValue).Interior.ColorIndex = sCor

Att..

Share this post


Link to post
Share on other sites
vbalexandre

Boa noite!!

Bom resolvi o problema eu troquei por 20 ao invés de 59, não sei como mas deu verto. :cheesygrin:

'Soma + 1 para a proxima Cor

      sCor = sCor + 1

    If sCor = 59 Then

   

      sCor = 1

        End If

    Wend

   

End Sub

Muito Obrigado..Andrepereira9..abraços

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.