Bom dia,

Veja se este código atende a sua necessidade:

Sub Diagonal()
    Dim Intervalo As Range
    Dim Celula As Range
    Dim k As Integer
    Dim i As Integer
    Dim Qtde As Integer
    Dim QtEnc As Integer
    
    Qtde = [AD2].Value
    Set Intervalo = [H4:AB102]
    
    With Intervalo
        .Font.Color = vbBlack
        .Font.Bold = False
    End With
    
    For Each Celula In Intervalo
        If Celula.Font.Color <> vbBlue Then
            Celula.Select
            QtEnc = 0
            For k = 1 To Qtde
                If ActiveCell.Value = 1 Then
                    QtEnc = QtEnc + 1
                    ActiveCell.Offset(1, 1).Select
                    If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
                Else
                    Exit For
                End If
            Next
            If QtEnc = Qtde Then
                For i = 1 To Qtde
                    ActiveCell.Offset(-1, -1).Select
                    ActiveCell.Font.Color = vbBlue
                    ActiveCell.Font.Bold = True
                Next
            End If
        End If
    Next
    
    For Each Celula In Intervalo
        If Celula.Font.Color <> vbRed Then
            Celula.Select
            QtEnc = 0
            For k = 1 To Qtde
                If ActiveCell.Value = 1 Then
                    QtEnc = QtEnc + 1
                    ActiveCell.Offset(1, -1).Select
                    If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
                Else
                    Exit For
                End If
            Next
            If QtEnc = Qtde Then
                For i = 1 To Qtde
                    ActiveCell.Offset(-1, 1).Select
                    ActiveCell.Font.Color = vbRed
                    ActiveCell.Font.Bold = True
                Next
            End If
        End If
    Next
End Sub

A macro verifica se há sequencias de "1", na quantidade especificada, na diagonal da esquerda para a direita descendo (azul) ou subindo (vermelho).
A eficiência do código precisa ser melhorada, pois você tem 80 mil linhas, porém não sei se é isso mesmo que quer.
A macro inicialmente, formata a fonte para a cor preta.
Se for isso mesmo, podemos tentar melhorar o código.
Caso não seja informe o que tem que ser alterado.

Abraço

Agradeço a atenção Jvalq, vou tentar o recomendado e postarei depois o resultado. Como afirmei no post anterior não tenho nenhum conhecimento de VBA.

Boa tarde
Jvalq, a macro por muito pouco não atende meu pedido, como postei na madruga, já cansado e com sono alguns detalhes ficaram de fora, segue uma explicação com mais detalhes.

Abraço

Bom dia
Como havia dito antes, o código ficou quase do jeito que tem de ficar, analisando outra vez o meu pedido pude verificar através do vba que poderia ser simplificado as coisas. Então reformulei mas sem alterar a estrutura básica do problema e solução.

abraço

Boa noite,

Alterei o código e incluí comentários para facilitar o entendimento.
A nova macro vai procurar a sequencia de "1" a partir da "coluna1" e não de qualquer célula do intervalo como no código anterior.
Veja se atende:

Sub Diagonal()
    Dim Intervalo As Range
    Dim Coluna1 As Range
    Dim Celula As Range
    Dim k As Integer
    Dim i As Integer
    Dim QtdeVermelha As Integer
    Dim QtdeAzul As Integer
    Dim QtEnc As Integer
    
    
    QtdeVermelha = [AD4].Value
    QtdeAzul = [AG4].Value
    
    'Intervalo onde vai ser realizada a busca
    Set Intervalo = [D6:Y104]
    
    'Coluna a partir de onde serão procuradas
    'as sequencias de "1"
    Set Coluna1 = [Y6:Y104]
    
    'Atribui fonte preta sem negrito em todo o intervalo
    With Intervalo
        .Font.Color = vbBlack
        .Font.Bold = False
    End With
    
    'Para cada célula da coluna1
    For Each Celula In Coluna1
        
        'Seleciona a célula
        Celula.Select
        
        'Zera a quantidade encontrada de "1"
        QtEnc = 0
        
        'Verifica se há uma sequencia na quantidade desejada
        For k = 1 To QtdeAzul
        
            'Se o valor da célual for 1
            If ActiveCell.Value = 1 Then
                
                'Aumenta a quantidade encontrada
                QtEnc = QtEnc + 1
                
                'Seleciona uma célula acima e à esquerda
                ActiveCell.Offset(-1, -1).Select
                
                'Verifica se a célula faz parte do intervalo
                If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
            Else
            
                'Caso contrário sai do laço e reinicia a busca na célula
                'seguinte da coluna1
                Exit For
            End If
        Next
        
        'Se a quantidade desejada é igual à encontrada
        If QtEnc = QtdeAzul Then
            
            'Formata as células em azul com negrito
            For i = 1 To QtdeAzul
                ActiveCell.Offset(1, 1).Select
                ActiveCell.Font.Color = vbBlue
                ActiveCell.Font.Bold = True
            Next
        End If
    Next
    
    'Repete o processo para a cor vermelha
    For Each Celula In Coluna1
        If Celula.Font.Color <> vbRed Then
            Celula.Select
            QtEnc = 0
            For k = 1 To QtdeVermelha
                If ActiveCell.Value = 1 Then
                    QtEnc = QtEnc + 1
                    ActiveCell.Offset(1, -1).Select
                    If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
                Else
                    Exit For
                End If
            Next
            If QtEnc = QtdeVermelha Then
                For i = 1 To QtdeVermelha
                    ActiveCell.Offset(-1, 1).Select
                    ActiveCell.Font.Color = vbRed
                    ActiveCell.Font.Bold = True
                Next
            End If
        End If
    Next
End Sub

Você pode alterar o intervalo desejado na seguinte linha:

Set Intervalo = [D6:Y104]

Para o intervalo de 80.000 linhas vai ficar algo parecido com isso:

Set Intervalo = [D6:Y80000]

Deve alterar, também, a coluna1:

Set Coluna1 = [Y6:Y80000]

Abraço

Muito bom o seu trabalho, mas eu pediria que desse uma "arrumada" em duas coisas: 1º - Na cx. de qte de valores a formatar. Quando os valores são trocados, tem de ir no Vba e dar um f8 e f5, tem como evitar isso. 2º - Mudei de black para gray (.Font.Color = vbGray) mas o não deu certo. Então resolvi fazer pelo excel usando, localizar - substituir a cor da fonte para cinza, mas aí a formatação desaparece, fica tudo cinza. Se todos os não formatados ficarem cinza normal a visualização dos resultados ficaria ótimo, mas se não houver maneira de alterar, fico grato da mesma forma, sua ajuda foi de grande valia.

Abraço

Boa tarde,

Alterei a cor para cinza claro (ColorIndex = 15).
Se quiser cinza escuro o código é 16.
Desabilitei a atualização de tela para a execução ficar mais rápida.
Caso queira com atualização de tela é só excluir a linha "Application.ScreenUpdating = False".

1º - Na cx. de qte de valores a formatar. Quando os valores são trocados, tem de ir no Vba e dar um f8 e f5, tem como evitar isso.

Não entendi o seu problema acima.

Sub Diagonal()
    Dim Intervalo As Range
    Dim Coluna1 As Range
    Dim Celula As Range
    Dim k As Integer
    Dim i As Integer
    Dim QtdeVermelha As Integer
    Dim QtdeAzul As Integer
    Dim QtEnc As Integer
    
    'Caso queira que rode mais rápido, sem
    'atualização da tela
    Application.ScreenUpdating = False
    
    QtdeVermelha = [AD4].Value
    QtdeAzul = [AG4].Value
    
    'Intervalo onde vai ser realizada a busca
    Set Intervalo = [D6:Y80000]
    
    'Coluna a partir de onde serão procuradas
    'as sequencias de "1"
    Set Coluna1 = [Y6:Y80000]
    
    'Atribui fonte cinza claro sem negrito em todo o intervalo
    With Intervalo.Font
        .ColorIndex = 15
        .Bold = False
    End With
    
    'Para cada célula da coluna1
    For Each Celula In Coluna1
        
        'Seleciona a célula
        Celula.Select
        
        'Zera a quantidade encontrada de "1"
        QtEnc = 0
        
        'Verifica se há uma sequencia na quantidade desejada
        For k = 1 To QtdeAzul
        
            'Se o valor da célual for 1
            If ActiveCell.Value = 1 Then
                
                'Aumenta a quantidade encontrada
                QtEnc = QtEnc + 1
                
                'Seleciona uma célula acima e à esquerda
                ActiveCell.Offset(-1, -1).Select
                
                'Verifica se a célula faz parte do intervalo
                If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
            Else
            
                'Caso contrário sai do laço e reinicia a busca na célula
                'seguinte da coluna1
                Exit For
            End If
        Next
        
        'Se a quantidade desejada é igual à encontrada
        If QtEnc = QtdeAzul Then
            
            'Formata as células em azul com negrito
            For i = 1 To QtdeAzul
                ActiveCell.Offset(1, 1).Select
                ActiveCell.Font.Color = vbBlue
                ActiveCell.Font.Bold = True
            Next
        End If
    Next
    
    'Repete o processo para a cor vermelha
    For Each Celula In Coluna1
        Celula.Select
        QtEnc = 0
        For k = 1 To QtdeVermelha
            If ActiveCell.Value = 1 Then
                QtEnc = QtEnc + 1
                ActiveCell.Offset(1, -1).Select
                If Application.Intersect(ActiveCell, Intervalo) Is Nothing Then Exit For
            Else
                Exit For
            End If
        Next
        If QtEnc = QtdeVermelha Then
            For i = 1 To QtdeVermelha
                ActiveCell.Offset(-1, 1).Select
                ActiveCell.Font.Color = vbRed
                ActiveCell.Font.Bold = True
            Next
        End If
    Next
    
    'Restaura a atualização de tela
    Application.ScreenUpdating = True
End Sub

Abraço

Acontece assim: Se o valor a ser informado for, digamos 15, na caixa que informa a qte. de casos a serem formatados, ele formata, sem problemas, mas se houver alteração de 15 para 18 por exemplo, a troca (a nova formatação de valores) não acontece, então tenho que entrar no vba e depurar (f8 e f5) só então a nova formatação com 18 casos acontece, isso vale para qualquer troca de valor.

Boa noite,

Você quer que, havendo uma alteração na quantidade, a macro seja executada automaticamente?
Se for isso teremos que fazer um código para colocar no evento "Change" da sua planilha.
Do jeito que está, ao fazer qualquer alteração, é necessário executar a macro novamente.

Abraço

Jvalquer
É exatamente isso, mas se não for possível o incremento, não tem importância, só a ajuda que você me deu já está de bom tamanho.
Um abraço e o meu muito obrigado pela ajuda e ao planilhando.

Bom dia,

Para a macro ser executada automaticamente após alteração na célula AD4 ou AG4, coloque o seguinte código no evento "Change" da sua planilha:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$AD$4" Or Target.Address = "$AG$4" Then Diagonal
End Sub

Para fazer isso, no editor do VBA, dê um duplo clique no nome da planilha (lado esquerdo) e cole o código.

Abraço

Boa tarde
Um misto de esquecimento e burrice da minha parte, tem tomado seu precioso tempo e me causado aborrecimento, mas vamos lá: Fiz o que mandou fazer (change) funcionou direitinho, como a planilha original tem 80 mil linhas como já havia dito, separei e juntei lado a lado na mesma planilha. Repliquei as macros, funcionou a 1ª tabela (vermelho) procurando e encontrando o pedido, mas a 2ª tabela (azul) - criei uma 2ª change não sei se é correto - aparentemente busca mas não mostra e não tenho conhecimentos suficientes para solucionar o problema. A 2ª questão é um misto de esquecimento e burrice da minha parte, na planilha anexa tem o ocorrido.

Boa tarde,

Na adaptação que você fez do código, acredito que há um erro na seguinte linha:

Set Coluna1 = [AN5:AN41084]

Como a coluna a ser pesquisada é a da direita, acredito que o correto seria:

Set Coluna1 = [BQ5:BQ41084]

Provavelmente por este motivo a macro não funcionou.
Também acharia melhor definir o intervalo como [AN5] em vez de [BQ5] como você fez, apesar de que, talvez, funcione das duas maneiras.
Quanto ao ao algoritmo, entendi que a macro tinha que procurar sequencias de "1" na quantidade especificada, porém após a sua explicação, além disso a sequencia tem que terminar em "0".
Fiz um novo código para a sub "Azul", portanto é só adaptar para a "Vermelha":

Sub Azul()
    Dim Intervalo As Range
    Dim Coluna1 As Range
    Dim Celula As Range
    Dim k As Integer
    Dim i As Integer
    Dim QtdeVermelha As Integer
    Dim QtdeAzul As Integer
    Dim QtEnc As Integer
    
    Application.ScreenUpdating = False
    
    QtdeVermelha = [AM2].Value
    QtdeAzul = [AM3].Value
    
    Set Intervalo = [AN5:BQ41084]
    Set Coluna1 = [BQ5:BQ41084]
    
    With Intervalo.Font
        .ColorIndex = 15
        .Bold = False
    End With
    
    For Each Celula In Coluna1
        Celula.Select
        QtEnc = 0
        While ActiveCell.Value = 1 And Not Application.Intersect(ActiveCell, Intervalo) Is Nothing
            QtEnc = QtEnc + 1
            ActiveCell.Offset(-1, -1).Select
        Wend
        If QtEnc = QtdeAzul Then
            For i = 1 To QtdeAzul
                ActiveCell.Offset(1, 1).Select
                ActiveCell.Font.Color = vbBlue
                ActiveCell.Font.Bold = True
            Next
        End If
    Next
    
    For Each Celula In Coluna1
        Celula.Select
        QtEnc = 0
        While ActiveCell.Value = 1 And Not Application.Intersect(ActiveCell, Intervalo) Is Nothing
            QtEnc = QtEnc + 1
            ActiveCell.Offset(1, -1).Select
        Wend
        If QtEnc = QtdeVermelha Then
            For i = 1 To QtdeVermelha
                ActiveCell.Offset(-1, 1).Select
                ActiveCell.Font.Color = vbRed
                ActiveCell.Font.Bold = True
            Next
        End If
    Next
End Sub

Abraço

Cria um botão ou uma imagem de refresh e atribua a macro, assim vc altera e já clica no botão para start o Sub()

[]s