Erro em tempo de execução

Question

Bom tarde

Queria mais uma vez pedir a gentileza do Benzadeus, para um "probleminha" na execução do código de sua autoria. Informo a msg da janela e linha: erro em tempo de execução “91” A variável do bloco ”With” não foi definida”  A linha: strFirst rng . Address. O código em questão funciona 100%, sem erros em outra aplicação. Como não tenho conhecimentos suficientes para corrigir... 

Grato

Sub fMain()
    'Cells.Style = "Normal"
    'Cells.HorizontalAlignment = xlCenter
    
    Const cstrBanco As String = "BQ7:BS1006,BZ7:CB1006,CQ7:CS1006,CZ7:DB1006"
    
    Dim lngN As Long
    Dim rng As Range
    Dim col As Collection
    Dim lng As Long
    Dim lngOccur As Long
    Dim strFirst As String
    
    lngN = InputBox("Informe N")
    
    Set col = New Collection
    On Error Resume Next
    For Each rng In Range(cstrBanco)
        If rng >= lngN Then
            col.Add CStr(rng), CStr(rng)
        End If
    Next rng
    On Error GoTo 0
    
    For lng = 1 To col.Count
        lngOccur = 0
        Set rng = Range(cstrBanco).Find(col(lng), , , xlWhole)
        strFirst = rng.Address
        Do
            lngOccur = lngOccur + 1
            If lngOccur > lngN Then
                rng.Interior.Color = vbBlack
                rng.Font.Color = vbWhite
            End If
            Set rng = Range(cstrBanco).FindNext(rng)
        Loop While rng.Address <> strFirst
    Next lng
End Sub

Answer 1

Experimente trocar a linha

Set rng = Range(cstrBanco).Find(col(lng), , , xlWhole)

por:

Set rng = Range(cstrBanco).Find(col(lng), , xlValues, xlWhole, , , True, , False)

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Bom dia

Infelizmente a troca da linha acima não resolveu o problema: erro na linha strFirst = rng. Address 

Answer 3

Bom dia

Substitui a linha a acima como sugerido mas não deu certo. Permanece o erro na linha strFirst = rng.Address

Answer 4

nao deu certo

Answer 5

Não deu certo, troquei a linha mas o erro continua na linha informada antes

Answer 6

Boa noite

Queria informar a todos que não houve da minha parte, postagem abusiva como relatado pelo moderador do fórum. O que houve na verdade é que respondi ao Benzadeus o que havia ocorrido e na hora de enviar o site mostrou uma caixa informando que minha conta estava bloqueada, daí fiquei tentando mandar uma resposta varias vezes e sempre o fórum bloqueando. Esse o motivo real de aparecer tantas mensagens. Queria me desculpar com o Benzadeus e outros do fórum, mas não houve em momento algum abuso de minha parte.

Grato

Answer 7

Tudo bem, Carlito.

Sobre sua dúvida, não estou conseguindo detectar onde está o erro. Você poderia postar/disponibilizar quais são os valores que você está utilizando para rodar a macro? Acredito que encontraremos a solução do problema se eu ver quais são os dados que estão causando esse erro.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 8

Bom dia

Fiz varias tentativas para enviar um link (SendSpace) com a planilha e o código mas o fórum exibe a seguinte mensagem:

“O corpo do texto não pode conter imagens ou links até que possamos verificar sua conta”

 Vou tentar desse modo. (www.sendspace.com/file/c8oh41)

Answer 9

O erro estava acontecendo porque você formatou a exibição de números para serem mostrados dois algarismos, inclusive quando o número fosse menor que 10. Corrigi o problema no código.

Além disso, como melhoria, ajustei o código para que ele ignorasse células em branco:

Sub fMain()
    Const cstrBanco As String = "BQ7:BS1006,BZ7:CB1006,CQ7:CS1006,CZ7:DB1006"
    
    Dim lngN As Long
    Dim rng As Range
    Dim col As Collection
    Dim lng As Long
    Dim lngOccur As Long
    Dim strFirst As String
    
    On Error Resume Next
    lngN = InputBox("Informe N")
    If Err.Number > 0 Or lngN <= 0 Then GoTo Fim
    On Error GoTo 0
    
    Cells.Interior.ColorIndex = -4142
    Cells.Font.ColorIndex = xlAutomatic
    
    Set col = New Collection
    On Error Resume Next
    For Each rng In Range(cstrBanco)
        If rng <> "" Then
            If rng >= lngN Then
                col.Add rng.Text, rng.Text
            End If
        End If
    Next rng
    On Error GoTo 0
    
    For lng = 1 To col.Count
        lngOccur = 0
        Set rng = Range(cstrBanco).Find(col(lng), , xlValues, xlWhole, , , True, , False)
        strFirst = rng.Address
        Do
            lngOccur = lngOccur + 1
            If lngOccur > lngN Then
                rng.Interior.Color = vbBlack
                rng.Font.Color = vbWhite
            End If
            Set rng = Range(cstrBanco).FindNext(rng)
        Loop While rng.Address <> strFirst
    Next lng
Fim:
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 10

Bom dia

Você é craque, tinha q estar jogando no Barcelona. Muitíssimo agradecido.