Автоматическое заполнение значения столбца на основе другого столбца не выполняется при добавлении фильтра - PullRequest
0 голосов
/ 02 августа 2020

Я сделал рабочий лист с поддержкой макросов, где, когда я заполняю ячейку в столбце, C1, C2, C3 et c. соответствующие значению столбца в ID, все ячейки, соответствующие этому конкретному ID, заполняются одним и тем же значением в C1, C2 et c. И когда я удаляю значение из одной ячейки в Cx, оно автоматически удаляется из всех ячеек в Completed, которые соответствуют этому значению в ID.

Например. в данных ниже, я бы хотел, чтобы пустые ячейки (__) автоматически заполнялись Y s в столбцах C1, C2 и C3, когда я набираю Y s в другом ячейки.

Role      ID         C1     C2    C3         ....
 A         1                 Y    
 A         2          Y            Y
 A         5          Y      Y
 A         8          Y
 B         2          __           __ 
 B         8          __
 B        10                       Y
 C        1                  __
 C        10                       __

Для этого я использовал ответ, опубликованный @ VBasic2008 здесь . Спасибо @ VBasic2008! :)

У меня этот метод работает нормально. Однако, когда я добавляю фильтр в столбец Role для фильтрации только строк с ролями A и B, я обнаруживаю ошибку, и метод работает не так, как ожидалось. Может ли кто-нибудь скажите мне, почему это так и как это решить?

EDIT: Немного изменены фиктивные данные и объяснение, чтобы лучше отразить мои требования.

1 Ответ

1 голос
/ 02 августа 2020

Я бы предложил просто перебирать каждую ячейку идентификатора, пока не будет найдена пустая ячейка в этой строке.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ID As Long, completed As Variant, r As Long
  Application.EnableEvents = False
  If Sheet1.Cells(1, Target.Column).Value = "Completed" Then
    ID = Target.Offset(0, -1).Value
    completed = Target.Value
    r = 2
    Do Until Sheet1.Range("B" & r).Value = ""
      If Sheet1.Range("B" & r).Value = ID Then
        Sheet1.Range("C" & r).Value = completed
      End If
      r = r + 1
    Loop
  End If
  Application.EnableEvents = True
End Sub
...