VBA коды cla sh друг с другом - PullRequest
1 голос
/ 27 марта 2020

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

Итак, у меня есть эта часть, чтобы вернуть «свертку» для любых пустых ячеек «Продажи и производство», если «Отправлено» в столбце AU (47-й столбец).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim counter As Long
Dim lastcolumn As Long

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

'Shipped without Title Transfer
      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

Тогда у меня есть этот кусок, чтобы вернуть «x» в столбце AX (50-й столбец), если последний столбец продаж имеет «Передача титула».

Dim r As Range, r1 As Range, 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

'Automatically put "x" if Title Transfer in any Sales columns
  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, 50).Value = "x"
      Else
        Cells(Target.Row, 50).Value = ""
      End If
    End If
  End If

'This I have 8 Sales Column, however, I only put 1 line down for demonstration
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

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 = Evaluate("=MAX(IF(" & rg.Address & "<>"""",COLUMN(" & rg.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 50).Value = "x"
      Else
        Cells(Target.Row, 50).Value = ""
      End If
    End If
  End If

End Sub

Вот подпункт DoCells, который вызывает одна из линий.

Private Sub DoCells(r As Range)
    Dim r1 As Range
    For Each r1 In r.Cells
        With r1
            Select Case .Column
                Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
                    Call MasterChange(.Resize(1, 3))
                Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
                    Call MasterChange(.Offset(0, -1).Resize(1, 3))
                Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
                    Call MasterChange(.Offset(0, -2).Resize(1, 3))
            End Select
        End With
    Next
End Sub

Вот моя структура данных с использованием таблицы уценок:

| 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           | Comments | MB51 Shipped | FPS? | Plant | Title Transfer |
|--------|---------------|----------------|----------|--------------|-----|------------|-------------|-------------|------|----------------|------------|--------|-------|------------|-------|--------|----------------|------------|----------------|--------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|---------|------------|---------|------------------|----------|--------------|------|-------|----------------|
| Rollup | PS            | APU            | ABC      | 46C12        | 1   | BS1        | 0000-00-00  | 101         | 450  | 2019-12-31     | 2019-12-31 | Rollup | Green | Rollup     | Green | Sales  | Title Transfer | Yellow     | Title Transfer | Sales  |         |            |         | Sales/Production |         |            |         | Sales/Production |         |            |         | Sales/Production |         |            |         | Sales/Production |         |            |         | Sales/Production |         |            |         | Sales/Production |          |              |      |       | x              |
| Yellow | PS            | FEP            | ADG      | PS3          | 3   | BS3        | 0000-00-00  | 103         | 180  | 2019-12-16     | 2019-12-20 | Yellow | Green | Rollup     | Green | Sales  | Title Transfer | Yellow     | Title Transfer | Sales  | Rollup  | Rollup     | Rollup  | Sales/Production | Rollup  | Rollup     | Rollup  | Sales/Production | Rollup  | Rollup     | Rollup  | Sales/Production | Rollup  | Rollup     | Rollup  | Sales/Production | Rollup  | Rollup     | Rollup  | Sales/Production | Rollup  | Rollup     | Rollup  | Sales/Production |          | Shipped      |      |       |                |
| Rollup | T6T           | OEM            | FEDS     | 67C          | 5   | BS5        | 0000-00-00  | 105         | 250  | 2019-12-23     | 2019-12-22 | Rollup | Green | Rollup     | Green | Sales  | Title Transfer | Yellow     | Title Transfer | Sales  | Shipped | Rollup     | Shipped | Sales/Production | Shipped | Rollup     | Shipped | Sales/Production | Shipped | Rollup     | Shipped | Sales/Production | Shipped | Rollup     | Shipped | Sales/Production | Shipped | Rollup     | Shipped | Sales/Production | Shipped | Rollup     | Shipped | Sales/Production |          | Shipped      |      |       | x              |

К вашему сведению, у меня всего 8 дней, каждый день представляет собой комбинацию из 4 столбцов с одинаковым порядком: продажи, производство, день, статус. Диапазон от столбца N до столбца BS (или AS в фактической рабочей книге Excel).

Как видно из таблицы:

1) 1-й ряд сделал именно то, что я хотел. Он правильно оценил «Передачу заголовка» в столбце «Продажи» / столбец R (2-го дня) как последний столбец «Продажи» с «Передачей заголовка» и вернул «x» в столбце BX (или столбце AX в моем файле Excel) .

2) 2-й ряд, коды возвращали как правильные, так и неправильные результаты. Сначала я поместил «Передача заголовка» в столбец «Продажи», а затем макрос возвратил «x» в столбце BX. Это правильно.

Однако, когда я поместил «Отправлено» в столбце BU после того, как в столбце BX сначала было указано «Передача заголовка», «x» был заменен кодами Отправления, которые я разместил выше. Оно вернуло «Свертывание» для всех пустых ячеек «Продажи и производство», когда я поместил «Отгружено» в столбец BU (47-й столбец или столбец AU в моем файле Excel). Но «х», обозначающий передачу названия, пропал.

Итак, вот проблема, с которой я боролся на прошлой неделе. Подскажите, пожалуйста, как я могу решить эту проблему? 3) 3-я строка - это то, что я хотел, чтобы мои коды делали, если и «Отправлено» в столбце BU, и «x» в столбце BX (очевидно, это не будет работать)

Короче, мои коды должны были быть выполнены следующее:

1) Если в столбце BU указано «Отправлено» (AU в текущем файле Excel), а в столбце BX нет «AX» (в текущем файле Excel AX), тогда возвращается «Свертывание» для всех пустые ячейки «Продажи и производство»

2) Если в последнем столбце «Продажи» указано «Передача заголовка», а в столбце BU нет «Отправлено» (AU в фактическом файле Excel), верните «x» в столбце BX (AX в фактический файл Excel)

3) Если «Передача заголовка» в последнем столбце «Продажи» (должно произойти первым) и «Отправлено» в столбце «BU» (происходит позже) (AU в текущем файле Excel), вернуть «x» в столбце BX и «поставляется» во всех пустых ячейках продаж и производства

Не могли бы вы помочь, как заставить его работать таким образом? Большое спасибо, и, пожалуйста, дайте мне знать, если вам нужна дополнительная информация.

Ps: Это то, что MasterChange имеет:

Public Sub MasterChange(SPD As Range)
    Dim rSales As Range
    Dim rProduction As Range
    Dim rDay As Range

    Set rSales = SPD.Cells(1, 1)
    Set rProduction = SPD.Cells(1, 2)
    Set rDay = SPD.Cells(1, 3)

    Application.EnableEvents = False
    If rSales = "Rollup" And rProduction = "Rollup" Then
        rDay = "Rollup"
    ElseIf rSales = "Rollup" And rProduction = "Green" Then
        rDay = "Green"
    ElseIf rSales = "Rollup" And rProduction = "Yellow" Then
        rDay = "Yellow"
'I have approximately 40 Ifs statements like those but above are just a few for demonstration
    End If
        Application.EnableEvents = True
    End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...