Excel VBA пропускает ту же строку кода, и я бы предпочел, чтобы это не - PullRequest
Новая
       9

Excel VBA пропускает ту же строку кода, и я бы предпочел, чтобы это не

1 голос
/ 07 ноября 2019

Я впервые работаю с VBA-кодером, поэтому мой код, вероятно, изобилует неэффективностью. Я собрал этот код вместе из различных интернет-источников, но не могу найти подходящий ответ на эту проблему, которая вызывает у меня сильную головную боль.

Короче говоря, код берет необработанные данные и перемещает ихв лист, предназначенный для месяца для этого отчета. После добавления столбцов и формул макрос отфильтрует обработанные необработанные данные, а отфильтрованные результаты будут скопированы и скопированы в лист интерфейса пользователя (Запросы), где будет применена проверка выпадающих данных (для обеспечения согласованного ответа),наряду с условным форматированием, чтобы выделить затронутые ячейки.

И это все. Это все, что нужно сделать этому коду. Но здесь есть один важный момент: каждый раз, когда я запускаю этот код, пропускается как минимум одна строка кода. Я знаю, что код работает, потому что мне удалось скопировать код на пустой лист и (в конце концов) все строки кода запускаются. Но независимо от того, сколько раз я пытаюсь, я не могу заставить код работать полностью в моем живом листе.

Я должен указать, что я могу 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,""missed"",""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, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, 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, Formula1:= _
       "=AND(F6=""missed"",H6="""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(255, 0, 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(0, 176, 80)
       .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, Formula1:= _
       "=AND(F6=""met"",H6<>"""")"
   Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
   With Selection.FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = RGB(255, 192, 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
'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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...