Найдите последний столбец с указанным значением c

Question

У меня есть файл с 8+ столбцами «Продажи», разбросанными по всему листу. Я попытался выполнить следующий код: если в каких-либо ячейках продаж есть «Передача заголовка», то в 51-м столбце будет «x».

Option Explicit
Public Const colTTransfer As Long = 51

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastColumn As Long
Dim counter As Long

lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column

    If Me.Cells(1, Target.Column).Value = "Sales" Then

        For counter = 1 To lastColumn

            If Me.Cells(Target.Row, counter).Value = "Title Transfer" Then

            Me.Cells(Target.Row, colTTransfer).Value = "x"

            End If

        Next counter

    End If

End Sub

Однако я понял, что в моей первоначальной цели было больше вышеуказанные коды не были гибкими. Мои коды проверяют любые ячейки продаж, которые Title Transfer, но они не отражают изменения других ячеек продаж в тех же строках.

Например, если ячейка в моем первом столбце продаж имеет Title Transfer, то 51-й столбец вернет x. И если ячейка во 2-м столбце «Продажи» в той же строке имеет другое значение, например, Green, x в 51-м столбце следует удалить (что не может сделать мой код)

Так что я мне интересно, есть ли способ вернуть x только для последний столбец продаж, который имеет Title Transfer?

Например, если предположить, что эти события происходят в той же строке, где:

• 1-й столбец продаж имеет Green, а 51-й столбец остается пустым
• 2-й столбец продаж имеет Title Transfer, а 51-й столбец имеет x
• 3-й столбец продаж имеет Rollup и 51-й столбец становится пустым
• 4-й столбец продаж имеет Red, а 51-й столбец остается прежним
• 5-й столбец продаж имеет Title Transfer, а 51-й столбец теперь имеет x и и так далее

Вот как выглядят мои данные:

| Title  | Engine   Family  | Market Segment | Customer | Engine Model | S/N | Build Spec | ACTL.FINISH | Sales Order | Item  | Committed Date | EPS Date   | Target | Sales | Production | Day 1 | Status | Sales          | Production | Day 2 | Status | Sales  | Production | Day 3 | Status | Sales | Production | Day 4 | Status | Sales          | Production | Day 5 | Status | Sales  | Production | Day 6 | Status | Sales          | Production | Day 7 | Status | Sales | Production | Day 8 | Status | Status | Comments | MB51 Shipped | FPS? | Plant | Title Transfer |
|--------|------------------|----------------|----------|--------------|-----|------------|-------------|-------------|-------|----------------|------------|--------|-------|------------|-------|--------|----------------|------------|-------|--------|--------|------------|-------|--------|-------|------------|-------|--------|----------------|------------|-------|--------|--------|------------|-------|--------|----------------|------------|-------|--------|-------|------------|-------|--------|--------|----------|--------------|------|-------|----------------|
| Rollup | PS               | APU            | HAC      | T-62T-46C12  | 1   | BS1        | 0000-00-00  | 0           | 0     | 2019/12/31     | 2019/12/31 |        | Green |            |       |        | Title Transfer |            |       |        | Rollup |            |       |        | Red   |            |       |        | Title Transfer |            |       |        | Rollup |            |       |        | Title Transfer |            |       |        |       |            |       |        |        |          |              |      |       |  x             |
|        |                  |                |          |              |     |            |             |             |       |                |            |        |       |            |       |        |                |            |       |        |        |            |       |        |       |            |       |        |                |            |       |        |        |            |       |        |                |            |       |        |       |            |       |        |        |          |              |      |       |                |
|        |                  |                |          |              |     |            |             |             |       |                |            |        |       |            |       |        |                |            |       |        |        |            |       |        |       |            |       |        |                |            |       |        |        |            |       |        |                |            |       |        |       |            |       |        |        |          |              |      |       |                |

Ссылка на образец

Пожалуйста, посоветуйте, как я могу заставить его работать таким образом. Любая помощь высоко ценится. Спасибо

Answer 1

Я нашел свой ответ. Тем не менее, спасибо всем за помощь

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, r1 As Range, lastColumn As Long, counter As Long
  Dim MaxCol As Variant, rg As Range, j As Long

  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(Target.Column).Resize(, 3))
    Call DoCells(r)
  End If

  ' Get last column based on first row
  lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
  If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
    For counter = 1 To lastColumn
      If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
        Me.Cells(Target.Row, counter).Value = "Rollup"
      End If
    Next counter
  End If

  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = 0
    For j = Columns("AP").Column To Columns("N").Column Step -4
      If Cells(Target.Row, j) <> "" Then
        If j > MaxCol Then MaxCol = j
      End If
    Next
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
  End If
End Sub

Answer 2

Вам просто нужно переместить обновление поля Передача заголовка в конец l oop и оценить каждый столбец Продаж до конца. Обновленный код должен разрешить это.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column < colTTransfer Then
        If Trim(UCase(Me.Cells(1, Target.Column).Value)) = "SALES" Then
            Dim lastColumn As Long
            Dim counter As Long
            Dim rowIsTitleTransfer As Boolean

            lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
            rowIsTitleTransfer = False

            ' loop
            For counter = 1 To lastColumn
                If Trim(UCase(Me.Cells(1, Target.Column).Value)) = "SALES" Then
                    rowIsTitleTransfer = Me.Cells(Target.Row, counter).Value = "Title Transfer"
                End If
            Next counter

            ' assign title transfer column
            If rowIsTitleTransfer Then
                Me.Cells(Target.Row, colTTransfer).Value = "x"
            Else
                Me.Cells(Target.Row, colTTransfer).Value = ""
            End If
        End If
    End If
End Sub