Ввод значения ячейки, если одна из ячеек в диапазоне изменяется и удаляется, если диапазон пуст

Я хочу сделать код, который добавляет определенное значение в первый столбец, если значения добавляются в определенный диапазон. И удалите это значение, если этот диапазон пуст. Это то, что у меня есть до сих пор, но я продолжаю получать ошибки, и я не могу понять, что я делаю неправильно.

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, cell As Range On Error GoTo haveError Set rng = Application.Intersect(Target, Me.Range("B1:G100")) If Not rng Is Nothing Then Application.EnableEvents = False For Each cell In rng.Cells If cell.Value = "blah" Then Range("A" & cell.Row).Value = "derp" End If Next For Each cell In rng.Cells If Range("B" & cell.Row, "G" & cell.Row).Value = "" Then Range("A" & cell.Row).ClearContents End If Next Application.EnableEvents = True End If Exit Sub haveError: MsgBox Err.Description Application.EnableEvents = True End Sub 

Вы получили ошибку Type mismatch для неправильного синтаксиса в этой строке:

 If Range("B" & cell.Row, "G" & cell.Row).Value = "" Then 

Итак, я изменил его, и он работает хорошо. Я также уменьшаю один цикл, потому что оба условия могут задаваться только одним циклом.

Здесь полный код:

 Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, cell As Range On Error GoTo haveError Set rng = Application.Intersect(Target, Me.Range("B1:G100")) If Not rng Is Nothing Then Application.EnableEvents = False For Each cell In rng.Cells If cell.Value = "blah" Then Me.Range("A" & cell.Row).Value = "derp" End If If WorksheetFunction.CountA(Me.Range("B" & cell.Row & ":" & "G" & cell.Row)) = 0 Then Me.Range("A" & cell.Row).ClearContents End If Next Application.EnableEvents = True End If Exit Sub haveError: MsgBox Err.Description Application.EnableEvents = True End Sub 

Я реорганизовал некоторые команды и только выполнил действия, когда они необходимы.

 Private Sub Worksheet_Change(ByVal Target As Range) 'don't do anything unless there is something to do If Not Intersect(Target, Me.Range("B1:G100")) Is Nothing Then On Error GoTo haveError 'don't declare vars until you kow you will need them Dim rng As Range, cell As Range Application.EnableEvents = False Set rng = Application.Intersect(Target, Me.Range("B1:G100")) For Each cell In rng.Cells If cell.Value = "blah" Then Range("A" & cell.Row).Value = "derp" ElseIf Application.CountBlank(Cells(cell.Row, "B").Resize(1, 6)) = 6 Then Cells(cell.Row, "A").ClearContents End If End If GoTo safeExit haveError: If CBool(Err.Number) Then 'Debug.Print Err.Number & ": " & Err.Description MsgBox Err.Number & ": " & Err.Description Err.Clear End If safeExit: Set rng = Nothing Application.EnableEvents = True End Sub 

Вместо того, чтобы иметь два для каждого … Следующее утверждение , я использовал If ... ElseIf ... End If поскольку условия являются взаимоисключающими (т. If ... ElseIf ... End If одно верно, другое не может быть истинным).

Давайте будем гением компьютера.