Este fórum está sendo desativado

[mineiro99]

Bom tarde.

Tenho uma planilha com blocos de linhas que são pontuadas como "C", "PC", "NC", "NA" ou vazia.
Se a pontuação de qualquer linha dentro do bloco for "PC" ou "NC" (coluna E), inserir na coluna G, após a última linha do bloco, o valor 1. Caso contrário, valor 0 (zero)
Esses blocos de linhas podem variar de 3 a 6 linhas e se estendem até a linha 1500.
Segue a planilha com maiores explicações.

Obrigado.

[osvaldomp]

Experimente:

Sub InsereValor()
Dim r As Range
For Each r In Columns(5).SpecialCells(2).Areas
If Application.CountIf(r, "PC") + Application.CountIf(r, "NC") > 0 Then
r.Cells(r.Rows.Count, 1).Offset(1, 2).Value = 1
Else: r.Cells(r.Rows.Count, 1).Offset(1, 2).Value = 0
End If
Next r
End Sub

[mineiro99]

É possível fazer essa pontuação automática, ou seja, quando eu fizer qualquer alteração a pontuação já seja calculada?

[osvaldomp]

É possível fazer essa pontuação automática, ~~~> sim.

ou seja, quando eu fizer qualquer alteração ... ~~~> alteração onde ? que tipo de alteração? mostre exemplos.

É uma boa prática agradecer a toda tentativa de ajuda recebida.

Ainda, informe se o código que eu sugeri apresentou os resultados desejados.

[mineiro99]

Bom dia Osvaldo!

Em primeiro lugar, obrigado por me ajudar com a macro. Não havia agradecido ainda.
sua sugestão funcionou perfeitamente. Mas não seria possível deixá-la rodando como:
Private Sub Worksheet_Change(ByVal Target As Range)
Tentei colocar sua sugestão neste modelo, mas não deu certo.
Se puder me ajudar fico lhe muito grato.

[osvaldomp]

Olá, Mineiro.

É possível sim executar via WS_Change, mas precisamos que você nos passe as informações solicitadas, conforme repetidas abaixo.

ou seja, quando eu fizer qualquer alteração ... ~~~> alteração onde ? que tipo de alteração? mostre exemplos.

[mineiro99]

Osvaldo,
A ideia é essa: quando eu inserir "PC" ou "NC" nas células da coluna E que compõem cada bloco, na coluna G inserir o número 1, conforme a planilha anexa.

[mineiro99]

Segue uma imagem:

https://imgur.com/a/wUlUMbb

[osvaldomp]

Veja se atende.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, a As Range, k As Long
If Target.Count > 1 Then Exit Sub
If Target.Column <> 5 Or (Target.Offset(, -1).Value = "" And Target.Offset(, 1).Value = "") Then Exit Sub
For Each r In Columns(4).SpecialCells(2).Areas
If Not Intersect(r.CurrentRegion, Target) Is Nothing Then
If r.CurrentRegion.Columns.Count = 5 Then k = -1
Set a = r.Cells(1, 1).Resize(r.CurrentRegion.Rows.Count + k).Offset(, 1)
If Application.Sum(Application.CountIf(a, Array("PC", "NC"))) > 0 Then
r.Cells(1, 1).Offset(r.CurrentRegion.Rows.Count + k, r.CurrentRegion.Columns.Count - 1 + k).Value = 1
Else: r.Cells(1, 1).Offset(r.CurrentRegion.Rows.Count + k, r.CurrentRegion.Columns.Count - 1 + k).Value = 0
End If
Exit Sub
End If
Next r
End Sub

[mineiro99]

Ficou perfeito!

Muito obrigado.