Este fórum está sendo desativado

[Saulo]

Boa Tarde!
Pedido de Ajuda: Teria Como acrescentar uma Rotina a macro abaixo de forma que quando se escolher a variável “Cancelado” na célula F9 da Sheets (“INSERIR”), essa nova rotina deverá atribuir o valor 0 (Zero) nas respectivas células da coluna H da Sheets (“Banco de dados”).
Desde já Agradeço!

Sub AtualizaCTEV1()
Dim WSP As Worksheet
Dim WSIP As Worksheet
Dim WSPLinha As Long
Set WSP = Sheets("Banco de Dados")
Set WSIP = Sheets("INSERIR")
WSPLinha = 2
Do While WSP.Cells(WSPLinha, 1).Value <> ""
If WSP.Cells(WSPLinha, 1).Value = WSIP.Range("F3").Value Then
With WSP
If WSIP.Range("F4").Value <> "" Then .Cells(WSPLinha, 10).Value = WSIP.Range("F4").Value
If WSIP.Range("F5").Value <> "" Then .Cells(WSPLinha, 31).Value = WSIP.Range("F5").Value
If WSIP.Range("F6").Value <> "" Then .Cells(WSPLinha, 32).Value = WSIP.Range("F6").Value
If WSIP.Range("F7").Value <> "" Then .Cells(WSPLinha, 33).Value = WSIP.Range("F7").Value
If WSIP.Range("F8").Value <> "" Then .Cells(WSPLinha, 34).Value = WSIP.Range("F8").Value
If WSIP.Range("F9").Value <> "" Then .Cells(WSPLinha, 43).Value = WSIP.Range("F9").Value
If WSIP.Range("F10").Value <> "" Then .Cells(WSPLinha, 44).Value = WSIP.Range("F10").Value
If WSIP.Range("F11").Value <> "" Then .Cells(WSPLinha, 54).Value = WSIP.Range("F11").Value
End With
End If
WSPLinha = WSPLinha + 1
Loop
WSIP.Range("F3").Value = ""
WSIP.Range("F4").Value = ""
WSIP.Range("F5").Value = ""
WSIP.Range("F6").Value = ""
WSIP.Range("F7").Value = ""
WSIP.Range("F8").Value = ""
WSIP.Range("F9").Value = ""
WSIP.Range("F10").Value = ""
WSIP.Range("F11").Value = ""
End Sub

[babdallas]

Veja se ajuda. O ideal seria ter anexado a pasta de trabalho com o código.

Código: Selecionar todos

Sub AtualizaCTEV1()
    Dim WSP As Worksheet
    Dim WSIP As Worksheet
    Dim WSPLinha As Long
    Dim lngContLin  As Long
    Dim lngVal()    As Long
    
    lngVal = Array(10, 31, 32, 33, 34, 43, 44, 54)
    
    Set WSP = Sheets("Banco de Dados")
    Set WSIP = Sheets("INSERIR")
    
    WSPLinha = 2
    
    With WSIP
        Do While WSP.Cells(WSPLinha, 1).Value <> ""
            If WSP.Cells(WSPLinha, 1).Value = .Range("F3").Value Then
                For lngContLin = 1 To 8
                    If .Cells(lngContLin + 3, 6).Value <> "" Then _
                        WSP.Cells(WSPLinha, lngVal(lngContLin - 1)).Value = .Cells(lngContLin + 3, 6).Value
                Next lngContLin
            End If
            
            If .Range("F9").Value = Cancelado Then WSP.Cells(WSPLinha, 8).Value2 = vbNullString
            
            WSPLinha = WSPLinha + 1
        Loop
        
        For lngContLin = 3 To 11
            .Cells(lngContLin, 6).Value2 = vbNullString
        Next lngContLin
    End With
End Sub

[babdallas]

Esqueci de colocar o texto Cancelado entre aspas no código. Por favor corrija de Cancelado para "Cancelado".

[Saulo]

Prezado babdallas 26 Ago 2019 às 04:54, Boa Tarde
Apliquei seu código na planilha e deu Bug.
Anexei Desta vez a planilha com o código de origem.
Favor analisar e verificar se dá para implementar a rotina de replace conforme solicitação.
Desde já agradeço

[babdallas]

Veja se é isso.

[Saulo]

Prezado babdallas 26 Ago 2019 às 15:11
O seu código está dando Replace em toda a coluna H, inclusive no cabeçalho.
Desculpe! Talvez Eu não soube Expressar-me bem, é o Seguinte: o Replace Só Deverá Ser Aplicado ao Mesmo Nº DOC, ou seja, Se Escolhemos Por Exemplo o Nº DOC 195 na Planilha “INSERIR” e em seguida optamos por cancelá-lo (célula F9), neste caso somente a célula H203 na planilha “Banco de Dados” deverá sofrer a alteração, ou seja, o peso deverá ter seu valor em branco independente do valor que ali esteja, sendo que as demais células permanecem inalteradas, e assim sucessivamente, caso escolha o Nº DOC 193 a célula a ser alterada na planilha ‘Banco de Dados” será a H201.
Se for possível peço o obséquio que reavalie o processo .
Grato

[babdallas]

Veja agora.

[Saulo]

Preazado babdallas 26 Ago 2019 às 17:00
Primeiramente Muito Obrigado Por Dispor de Seu Tempo Para Ajudar-me.
Solução Perfeita, Funcionou Conforme Solicitado.
Grato.