Erro ao limpar várias células no Excel

Question

Estou usando Worksheet_Change para fazer um valor (1 ou 0) aparecer na próxima célula (Bx) quando um valor é inserido em um intervalo de células (A1: A10).

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        If Target.Value = 1 Then
            Target.Offset(0, 1).Value = 1 
        Else:
            Target.Offset(0, 1).Value = 0 
        End If
    End If
End Sub

O problema ocorre quando tento limpar as células na coluna A. Quando seleciono as células que desejo limpar e pressiono "Excluir", recebo "Erro em tempo de execução '13' - Tipo incompatível" na linha "IF Target.Value = 1 ".

Também gostaria que as células da coluna B fossem apagadas se eu limpar as células da coluna A. Por exemplo, se eu excluir a célula A2: A5, B2: B5 deve ser apagada.

Pelo que entendi, o problema é que ao selecionar várias células ele retorna uma matriz como o destino, e isso é uma incompatibilidade com o inteiro.

Existe uma maneira de contornar este problema?

Answer 1

Experimente isso. Você precisa atender a várias células de alguma forma, pelos motivos mencionados, e adicionar uma cláusula extra ao seu If.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range, r1 As Range

Set r = Intersect(Target, Range("A1:A10"))

If Not r Is Nothing Then
    For Each r1 In r
        If r1.Value = 1 Then
            r1.Offset(0, 1).Value = 1
        ElseIf r1.Value = vbNullString Then
            r1.Offset(0, 1).Value = vbNullString
        Else
            r1.Offset(0, 1).Value = 0
        End If
    Next r1
End If

End Sub

Answer 2

Em uma primeira etapa, adicionamos a funcionalidade de que várias células são selecionadas e alteradas:

Private Sub Worksheet_Change_Var1(ByVal Target As Range)
Dim targetCell As Range
    'If Target.Range.count
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        If Target.Cells.Count > 1 Then
            For Each targetCell In Target
            If targetCell.Value = 1 Then
                targetCell.Offset(0, 1).Value = 1
            Else
                targetCell.Offset(0, 1).Value = 0
            End If
            Next targetCell
        Else
            If Target.Value = 1 Then
                Target.Offset(0, 1).Value = 1
            Else
                Target.Offset(0, 1).Value = 0
            End If
        End If
    End If
End Sub

Na 2ª etapa entendemos que também o caso de "uma célula" pode ser tratado da mesma maneira e adicionamos uma cláusula if para o caso de "célula (s) apagada (s)":

Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetCell As Range
    'If Target.Range.count
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        For Each targetCell In Target
            If targetCell.Value = 1 Then
                targetCell.Offset(0, 1).Value = 1
            Else
                targetCell.Offset(0, 1).Value = 0
            End If

            'if cell in col A is empty, then clear cell in col B
            If targetCell.Value = "" Then targetCell.Offset(0, 1).ClearContents
        Next targetCell
    End If
End Sub