前端之家

  1. 首页
  2. 问答

Excel VBA跳过同一行代码，我真的更希望它不会

• 问答

我是第一次使用VBA编码器，因此我的代码可能效率低下。 我已经从各种Internet来源中整理了这段代码，但是找不到合适的答案来解决这个问题，这使我头疼不已。

简而言之，该代码获取原始数据并将其移至为该报告的月份设计的工作表中。 添加列和公式后，宏将过滤操作的原始数据，并将过滤后的结果填充到用户界面工作表（查询）中，并在其中进行下拉数据验证（以确保一致的响应），以及条件格式以突出显示受影响的单元格。

就是这样。这就是所有这些代码需要做的。但这是症结所在：每次运行此代码时，都会跳过至少一行代码。。我知道该代码有效，因为我设法将代码复制到空白工作表上，并且（最终）所有代码行都运行。但是无论我尝试多少次，都无法使代码在实时工作表中完全运行。

我应该指出，我可以通过代码执行F8，并且（总体上）它可以完美运行。

我在这里提供了代码供专家审核；也许有人可以提供有关解决问题区域的建议，以便每条生产线始终运行。 如果专家编码员可能提出任何建议，我也愿意改进我的代码。

预先感谢

Sub AnalyseDataButton()

Dim Month As String
   Month = Worksheets("Home").Range("B1")
Dim HlastRow As Long
   HlastRow = Worksheets("Home").Range("A" & Rows.Count).End(xlUp).Row
Dim IlastRow
   IlastRow = Worksheets(Month).Range("A" & Rows.Count).End(xlUp).Row
Dim lastRow As Long
   lastRow = Worksheets(Month).Range("K" & Rows.Count).End(xlUp).Row
Dim QlastRow As Long
   QlastRow = Worksheets("Queries").Range("A" & Rows.Count).End(xlUp).Row

  Worksheets("Home").Calculate

'Validating all data has been added
   If (Worksheets("Home").Range("A15") = "" Or Worksheets("Home").Range("K15") = "" Or Worksheets("Home").Range("U15") = "") Then
       MsgBox "Please ensure you have added all three reports",vbExclamation + vbOKOnly,"Unable to run reports"
   Else
'Complete all actions before showing results
   Application.ScreenUpdating = False


'Prepare the September sheet for data
   Worksheets(Month).UsedRange.ClearContents
'Move the data from Home to September,then clear the data from Home
   Worksheets("Home").Range("A15").Select
   Worksheets("Home").Range("A15:AA" & HlastRow).Copy Destination:=Worksheets(Month).Range("A1")
'Add additional columns as needed
   Worksheets(Month).Range("T1:W1").EntireColumn.Insert

'INCIDENTS
'Apply Header to actual Elapsed
   Worksheets(Month).Range("T1") = "actualElapsed"
'Apply Formula to T2
   Worksheets(Month).Range("T2") = "=ROUNDUP(VLOOKUP(K2,$A$2:$I" & IlastRow & ",6,FALSE)/86400,0)"
'Copy Formula down to last row
   Worksheets(Month).Range("T2").AutoFill Destination:=Worksheets(Month).Range("T2:T" & lastRow)
'Apply Header to actual Met
   Worksheets(Month).Range("U1") = "actualMet"
'Apply Formula to U2
   Worksheets(Month).Range("U2") = "=IF(NETWORKDAYS(M2,R2,HOLIDAYS)-1+MOD(M2,1)-MOD(R2,1)>5,""missed"",""met"")"
'Copy Formula down to last row
   Worksheets(Month).Range("U2").AutoFill Destination:=Worksheets(Month).Range("U2:U" & lastRow)
'Apply Header to Business Met
   Worksheets(Month).Range("V1") = "BusinessMet"
'Apply Formula to V2
   Worksheets(Month).Range("V2") = "=IF(VLOOKUP(K2,$A$2:$H$" & IlastRow & ",8,FALSE)>432000,""met"")"
'Copy Formula down to last row
   Worksheets(Month).Range("V2").AutoFill Destination:=Worksheets(Month).Range("V2:V" & lastRow)
'Remove any Wrapped text
   Worksheets(Month).Cells.wraptext = False
'Add Justification header on the Month tab
   Worksheets(Month).Range("W1").Value = "Justification"
'Determine the list of query items
   Worksheets("Queries").UsedRange.Clear
   Worksheets(Month).Calculate
   Worksheets(Month).Range("$K$1:$V$" & lastRow).AutoFilter Field:=11,Criteria1:="=missed"
   Worksheets(Month).Range("K1:M" & Cells(Rows.Count,"K").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("Queries").Range("A5")
'Add data validation to the actualMet
'### THIS STEP IS REGULARLY MISSED
   With Worksheets("Queries").Range("F6").Validation
   .Delete
   .Add Type:=xlValidateList,AlertStyle:=xlValidAlertStop,Operator:=xlBetween,Formula1:="=Dates!$G$1:$G$2"
   .IgnoreBlank = True
   .InCellDropdown = True
   .InputTitle = ""
   .InputMessage = ""
   .InputMessage = ""
   .ErrorMessage = ""
   .ShowInput = True
   .ShowError = True
   End With
'Add data validation to the actualMet
'### THIS STEP IS REGULARLY MISSED
   Worksheets("Queries").Range("F6").AutoFill Destination:=Worksheets("Queries").Range("F6:F" & QlastRow)
'Continue to move data to the Queries sheet
   Worksheets(Month).Range("R1:R" & Cells(Rows.Count,"K").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("Queries").Range("D5")
   Worksheets(Month).Range("T1:V" & Cells(Rows.Count,"K").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("Queries").Range("E5")
   Worksheets("Queries").Cells.wraptext = False
   Worksheets("Queries").Columns("A:I").EntireColumn.AutoFit
   Worksheets(Month).AutoFilterMode = False
   Worksheets("Queries").Range("H5") = "Reasons for breaching SLA"
'Add data validation to the Justification
'### THIS STEP IS SOMETIMES MISSED
'### WHEN THIS STEP IS MISSED,THE RESULTS SHOW THE MACRO STARTED ON RANGE("H5")
   With Worksheets("Queries").Range("H6").Validation
   .Delete
   .Add Type:=xlValidateList,Formula1:="=Dates!$J$1:$J$5"
   .IgnoreBlank = True
   .InCellDropdown = True
   .InputTitle = ""
   .InputMessage = ""
   .InputMessage = ""
   .ErrorMessage = ""
   .ShowInput = True
   .ShowError = True
   End With
   Worksheets("Queries").Range("H6").AutoFill Destination:=Worksheets("Queries").Range("H6:H" & QlastRow)
'Move to Queries sheet
   MsgBox "Thank you for uploading data." & vbNewLine & "" & vbNewLine & "*** INCIDENT TASKS ***" & vbNewLine & "You will now be shown the Incident Tasks which missed SLA." & vbNewLine & "Please provide justification or make amendments as required.",vbInformation,"Thank You"
   Worksheets("Queries").activate
'Header for Queries sheet
   Worksheets("Queries").Range("A4").FormulaR1C1 = "List of INCIDENT TASKS to be reviewed."
   Worksheets("Queries").Range("A4:H4").Select
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlBottom
       .wraptext = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Selection.Merge
   With Selection.Font
       .Name = "Calibri"
       .Size = 20
       .Strikethrough = False
       .Superscript = False
       .Subscript = False
       .OutlineFont = False
       .Shadow = False
       .Underline = xlUnderlinestyleNone
       .ThemeColor = xlThemeColorLight1
       .TintAndShade = 0
       .ThemeFont = xlThemeFontMinor
   End With
   With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 13532366
       .TintAndShade = 0
       .PatternTintAndShade = 0
   End With
'Add conditional formatting
'### THIS STEP IS SOMETIMES PERFORMED ON RANGE ("D1") OF THE QUERIES SHEET
   Worksheets("Queries").Cells.FormatConditions.Delete
   Worksheets("Queries").Range("H6:H" & QlastRow).Select
   Selection.FormatConditions.Add Type:=xlExpression,Formula1:= _
       "=AND(F6=""missed"",H6<>"""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).setfirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(0,176,80)
       .TintAndShade = 0
   End With
   Selection.FormatConditions.Add Type:=xlExpression,H6="""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).setfirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(255,0)
       .TintAndShade = 0
   End With
   Selection.FormatConditions.Add Type:=xlExpression,Formula1:= _
       "=AND(F6=""met"",H6="""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).setfirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(198,89,17)
       .TintAndShade = 0
   End With
   Selection.FormatConditions(1).StopIfTrue = False
   Worksheets("Queries").Range("F6:F" & QlastRow).Select
   Selection.FormatConditions.Add Type:=xlExpression,H6<>"""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).setfirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(255,192,17)
       .TintAndShade = 0
   End With
'Show results now the macro has run
   Worksheets("Queries").Range("H6").Select
   Application.ScreenUpdating = True
   MsgBox "Please review each task and select the reason for breaching SLA.",vbExclamation,"Review the Incident Tasks outside of SLA"

End If
End Sub
lbwaaa 回答：Excel VBA跳过同一行代码，我真的更希望它不会
暂时没有好的解决方案，如果你有好的解决方案，请发邮件至：iooj@foxmail.com
excelvalidationvba
本文链接：https://www.f2er.com/3145513.html

大家都在问