此Excel文件跟踪销售和生产部门的引擎状态。工作簿中的A至M列包含视为发动机状态所必需的数据。 N-AS列用于按照以下列顺序跟踪引擎状态：销售，生产，第1天，状态。一直重复到第8天（即销售，生产，第8天，状态）。
这8天代表该月的最后8天，并且在此期间每天将数据更新到A-M列。但是，假设今天是第二天，尽管很有可能在A到M列中更新数据，但第1天的列（销售，生产，第1天，状态）中的数据保持不变。然后，我们继续放下第二天的状态。
这是我的问题，我试图让宏执行：如果在AV列中“已Shipped”，则剩余的“空天数”在“销售”和“生产”列中都将具有“汇总”
您能告诉我为什么在将以下几行添加到“主工作表”之后，宏在添加这些代码之前就不再返回“天”列中的值了吗（根据模块的IF语句）？
Dim lastColumn As Long
Dim counter As Long
Application.EnableEvents = False
' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
' Get last column based on first row
lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
' Check all cells in row and find matches for Sales and Production
For counter = 1 To lastColumn
' Check if header match and cell is not empty
If (Me.Cells(1, counter).Value = "Sales" or Me.Cells(1, counter).Value = "Production") And Me.Cells(Target.Row, counter).Value = vbNullString Then
Me.Cells(Target.Row, counter).Value = "Rollup"
End If
Next counter
End If
Application.EnableEvents = True
谢谢！我道歉，因为有人建议不要包含启用了Macro的链接，因此在此处放置很多代码。
这是我的“主工作表”选项卡中当前的内容：
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, r1 As Range
Dim lastColumn As Long
Dim counter As Long
Application.EnableEvents = False
' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
' Get last column based on first row
lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
' Check all cells in row and find matches for Sales and Production
For counter = 1 To lastColumn
' Check if header match and cell is not empty
If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And Me.Cells(Target.Row, counter).Value = vbNullString Then
Me.Cells(Target.Row, counter).Value = "Rollup"
End If
Next counter
End If
Application.EnableEvents = True
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
If Not r Is Nothing Then Call DoCells(r)
End Sub
Private Sub DoCells(r As Range)
Dim r1 As Range
For Each r1 In r.Cells
With r1
Select Case .Column
Case colSales1
Call MasterChange(.Resize(1, 3))
Case colProduction1
Call MasterChange(.Offset(0, -1).Resize(1, 3))
Case colDay1
Call MasterChange(.Offset(0, -2).Resize(1, 3))
End Select
End With
Next
End Sub
这是在模块上：
Option Explicit
Public Const colSales1 As Long = 14
Public Const colProduction1 As Long = 15
Public Const colDay1 As Long = 16
Public Const colStatus1 As Long = 17
Sub UpdateMaster()
Dim r As Range
Dim wsMaster As Worksheet, wsSAP As Worksheet
If MsgBox("Do you want to update 'Master Worksheet' from 'SAP'?", vbYesNo + vbQuestion + vbDefaultButton2, "Update Master") = vbNo Then
Exit Sub
End If
Set wsMaster = Worksheets("Master Worksheet")
Set wsSAP = Worksheets("SAP")
'IMPORTANT -- turn off events
Application.EnableEvents = False
'get rid of old data
wsMaster.Cells.Clear
'copy SAP
wsSAP.Cells(1, 1).CurrentRegion.Copy wsMaster.Cells(1, 1)
'add formulas - double "" inside string to get one
Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus1)
Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
r.Formula = "=IF(O2=N2,""Sales/Production"",IF(P2=O2,""Production"",IF(P2=N2,""Sales"","""")))"
'IMPORTANT -- turn on events
Application.EnableEvents = True
End Sub
Sub ClearMaster()
Dim ws As Worksheet
Set ws = Workbooks("SampleReport03.xlsm").Sheets("Master Worksheet")
ws.Rows("2:" & Rows.Count).Clear
End Sub
Sub ClearSAP()
Dim ws As Worksheet
Set ws = Workbooks("SampleReport.xlsm").Sheets("SAP")
ws.Rows("2:" & Rows.Count).ClearContents
End Sub
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"
ElseIf rSales = "Rollup" And rProduction = "Red" Then
rDay = "Red"
ElseIf rSales = "Rollup" And rProduction = "Overdue" Then
rDay = "Overdue"
ElseIf rSales = " " And rProduction = " " Then
rDay.ClearContents
End If
Application.EnableEvents = True
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 | 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 | Rollup | Green | Yellow | Yellow | Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Rollup | Rollup | | Sales/Production | Sales/Production | | Shipped | | | |
| Rollup | PS | APU | SA | S2300 | 2 | BS2 | 2019/06/25 | 1 | 380 | 2019/06/24 | 2019/06/25 | Available | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | Sales/Production | | | | | |
| Yellow | PS | APU | AOG | PS3200 | 3 | BS3 | 0000-00-00 | 2 | 1 | 2019/12/16 | 2019/12/20 | Yellow | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | | | | Sales/Production | Sales/Production | | | | | |
如您所见，在第N，O列中输入状态后，我的宏确实返回了Yellow，没有任何故障或错误。然后，我将Shipped放在AV列中，宏确实为生产和销售列自动返回了Rollup，但是，宏在日列中不再起作用。
如果您需要更多信息，请告诉我，非常感谢您的帮助！
答案 0 :(得分：0)
下面的更改恢复了丢失的功能（据我从您的评论中了解）。有评论描述更改的原因和原因。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, r1 As Range
Dim lastColumn As Long
Dim counter As Long
Application.EnableEvents = False
' Get last column based on first row
'*** Need to set lastColumn outside of the Me.Cells(1, Target.Column).value = "MB51 Shipped" statement
'*** so that the Intersect function does not fail (blow-up) if a cell in a column other than "MB51 Shipped" is modified .
'*** Perhaps the Intersect call belongs within the If statement?
lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).value = "MB51 Shipped" Then
' Get last column based on first row
'lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
' Check all cells in row and find matches for Sales and Production
For counter = 1 To lastColumn
' Check if header match and cell is not empty
If (Me.Cells(1, counter).value = "Sales" Or Me.Cells(1, counter).value = "Production") And Me.Cells(Target.Row, counter).value = vbNullString Then
Me.Cells(Target.Row, counter).value = "Rollup"
End If
Next counter
End If
Application.EnableEvents = True
'***In the posted code, The Intersect() function was never returning a non-null Range
'***I think your intent was to find the intersection of the colSales1 column and the Target row
'Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
'*** This Intersect() call provides the range that I think you intended
Set r = Intersect(Range(Cells(Target.Row, 1), Cells(Target.Row, lastColumn)), Cells(1, 1).CurrentRegion)
If Not r Is Nothing Then Call DoCells(r)
End Sub
'*** DoCells was only attempting to operate on three columns, colSales1, colProduction1, and colDay1
'*** And...each of the Case statements is sending the same range to MasterChange -> so, it was doing the same operation 3 times
'*** I believe the intent was to call each Sales/Production/Days group and update...so, replacing the Select Case with
'*** the following if statement updates all the Sales/Production/Days groups.
Private Sub DoCells(r As Range)
Dim r1 As Range
For Each r1 In r.Cells
With r1
'Find each "Sales" column. Call MasterChange only once for each group
If Me.Cells(1, colSales1).value = r1.Offset(-1, 0).value Then
MasterChange .Resize(1, 3)
End If
'Select Case .Column
' Case colSales1
' Call MasterChange(.Resize(1, 3))
' Case colProduction1
' Call MasterChange(.Offset(0, -1).Resize(1, 3))
' Case colDay1
' Call MasterChange(.Offset(0, -2).Resize(1, 3))
'End Select
End With
Next
End Sub