如何使这段VBA代码自动化并改善其运行时间?

huangapple go评论48阅读模式
英文:

How to make this VBA code become automized and improve its running time?

问题

I developed a VBA code that can fill column B when column A is filled, at first the VBA code runs fast but when the number of cells filled is large the VBA code becomes very slow, how can I make the code run more efficiently so that it is no longer slow? I also want to make the code run automatically without having to create a shortcut to run the macro, so that every time new data is inputted in column A, column B will be filled in automatically. Here is my code

Sub CodeMaster_PipingTagSection()
    Dim lastrow As Long
    Dim i As Long
    
    lastrow = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
    
    For i = 7 To lastrow
        If Not IsEmpty(Cells(i, 9)) Then
            Cells(i, 6) = "TEMPERATE"
            Cells(i, 11) = Split(Cells(i, 9), "-")(UBound(Split(Cells(i, 9), "-")))
            Cells(i, 34) = "Three_Layer_PE_or_PP"
            Cells(i, 38) = "N"
            Cells(i, 41) = "N"
            Cells(i, 45) = "Review by Process SME"
            Cells(i, 54) = "False"
            Cells(i, 55) = "1"
            Cells(i, 56) = "N"
            Cells(i, 70) = "Piping"
            Cells(i, 71) = "PIPE"
            Cells(i, 75) = "Criticality RBI Component - Piping"
            Cells(i, 76) = "Non Intrusive"
            Cells(i, 83) = "True"
            Cells(i, 84) = "True"
            Cells(i, 85) = "N"
            Cells(i, 87) = "N"
            Cells(i, 88) = "N"
            Cells(i, 89) = "Visual Detection"
            Cells(i, 90) = "Manual Shutdown"
            Cells(i, 91) = "Inventory blowdown"
            Cells(i, 96) = "100"
            Cells(i, 98) = "False"
            Cells(i, 102) = "False"
        ElseIf IsEmpty(Cells(i, 9)) Then
            Cells(i, 6).ClearContents
            Cells(i, 11).ClearContents
            Cells(i, 34).ClearContents
            Cells(i, 38).ClearContents
            Cells(i, 41).ClearContents
            Cells(i, 45).ClearContents
            Cells(i, 54).ClearContents
            Cells(i, 55).ClearContents
            Cells(i, 56).ClearContents
            Cells(i, 70).ClearContents
            Cells(i, 71).ClearContents
            Cells(i, 75).ClearContents
            Cells(i, 76).ClearContents
            Cells(i, 83).ClearContents
            Cells(i, 84).ClearContents
            Cells(i, 85).ClearContents
            Cells(i, 87).ClearContents
            Cells(i, 88).ClearContents
            Cells(i, 89).ClearContents
            Cells(i, 90).ClearContents
            Cells(i, 91).ClearContents
            Cells(i, 96).ClearContents
            Cells(i, 98).ClearContents
            Cells(i, 102).ClearContents
        End If
    Next i
End Sub

To speed up the code I have tried turning off screen updating by inputting this code

Sub Stop_Events()
    Application.EnableEvents = False
    '...Statements
    Application.EnableEvents = True
End Sub

but it still runs slowly. I need other ways to make this VBA code run faster and automatically.

英文:

I developed a VBA code that can fill column B when column A is filled, at first the VBA code runs fast but when the number of cells filled is large the VBA code becomes very slow, how can I make the code run more efficiently so that it is no longer slow? I also want to make the code run automatically without having to create a shortcut to run the macro, so that every time new data is inputted in column A, column B will be filled in automatically. Here is my code

Sub CodeMaster_PipingTagSection()
    Dim lastrow As Long
    Dim i As Long
    
    lastrow = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
    
    For i = 7 To lastrow
        If Not IsEmpty(Cells(i, 9)) Then
            Cells(i, 6) = "TEMPERATE"
            Cells(i, 11) = Split(Cells(i, 9), "-")(UBound(Split(Cells(i, 9), "-")))
            Cells(i, 34) = "Three_Layer_PE_or_PP"
            Cells(i, 38) = "N"
            Cells(i, 41) = "N"
            Cells(i, 45) = "Review by Process SME"
            Cells(i, 54) = "False"
            Cells(i, 55) = "1"
            Cells(i, 56) = "N"
            Cells(i, 70) = "Piping"
            Cells(i, 71) = "PIPE"
            Cells(i, 75) = "Criticality RBI Component - Piping"
            Cells(i, 76) = "Non Intrusive"
            Cells(i, 83) = "True"
            Cells(i, 84) = "True"
            Cells(i, 85) = "N"
            Cells(i, 87) = "N"
            Cells(i, 88) = "N"
            Cells(i, 89) = "Visual Detection"
            Cells(i, 90) = "Manual Shutdown"
            Cells(i, 91) = "Inventory blowdown"
            Cells(i, 96) = "100"
            Cells(i, 98) = "False"
            Cells(i, 102) = "False"
        ElseIf IsEmpty(Cells(i, 9)) Then
            Cells(i, 6).ClearContents
            Cells(i, 11).ClearContents
            Cells(i, 34).ClearContents
            Cells(i, 38).ClearContents
            Cells(i, 41).ClearContents
            Cells(i, 45).ClearContents
            Cells(i, 54).ClearContents
            Cells(i, 55).ClearContents
            Cells(i, 56).ClearContents
            Cells(i, 70).ClearContents
            Cells(i, 71).ClearContents
            Cells(i, 75).ClearContents
            Cells(i, 76).ClearContents
            Cells(i, 83).ClearContents
            Cells(i, 84).ClearContents
            Cells(i, 85).ClearContents
            Cells(i, 87).ClearContents
            Cells(i, 88).ClearContents
            Cells(i, 89).ClearContents
            Cells(i, 90).ClearContents
            Cells(i, 91).ClearContents
            Cells(i, 96).ClearContents
            Cells(i, 98).ClearContents
            Cells(i, 102).ClearContents
        End If
    Next i
End Sub

to speed up the code I have tried turning off screen updating by input this code

Sub Stop_Events()
    Application.EnableEvents = False
    '...Statemets
    Application.EnableEvents = True
End Sub

but it still running slow, I need another ways to make this VBA running fast and automatically

答案1

得分: 1

Here is the code translated into Chinese:

尝试

    Sub SpeedUpCode()
        Dim lastrow As Long
        Dim data As Variant
        Dim i As Long
        
        lastrow = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row
        data = ActiveSheet.Range("A7:CX" & lastrow).Value '列 102-CX
        
        For i = 1 To UBound(data)
            If Not IsEmpty(data(i, 9)) Then
                data(i, 6) = "温和"
                data(i, 11) = Split(data(i, 9), "-")(UBound(Split(data(i, 9), "-")))
                data(i, 34) = "三层PE或PP"
                data(i, 38) = "N"
                data(i, 41) = "N"
                data(i, 45) = "由工艺专家审核"
                data(i, 54) = "假"
                data(i, 55) = "1"
                data(i, 56) = "N"
                data(i, 70) = "管道"
                data(i, 71) = "管道"
                data(i, 75) = "管道关键性RBI部件"
                data(i, 76) = "非侵入式"
                data(i, 83) = "真"
                data(i, 84) = "真"
                data(i, 85) = "N"
                data(i, 87) = "N"
                data(i, 88) = "N"
                data(i, 89) = "视觉检测"
                data(i, 90) = "手动关闭"
                data(i, 91) = "库存泄放"
                data(i, 96) = "100"
                data(i, 98) = "假"
                data(i, 102) = "假"
            ElseIf IsEmpty(data(i, 9)) Then
                data(i, 6) = ""
                data(i, 11) = ""
                data(i, 34) = ""
                data(i, 38) = ""
                data(i, 41) = ""
                data(i, 45) = ""
                data(i, 54) = ""
                data(i, 55) = ""
                data(i, 56) = ""
                data(i, 70) = ""
                data(i, 71) = ""
                data(i, 75) = ""
                data(i, 76) = ""
                data(i, 83) = ""
                data(i, 84) = ""
                data(i, 85) = ""
                data(i, 87) = ""
                data(i, 88) = ""
                data(i, 89) = ""
                data(i, 90) = ""
                data(i, 91) = ""
                data(i, 96) = ""
                data(i, 98) = ""
                data(i, 102) = ""
            End If
        Next i
        
        ActiveSheet.Range("A7:CX" & lastrow).Value = data
    End Sub

Please note that I've translated the code comments and some keywords while leaving the code itself unchanged.

英文:

try

Sub SpeedUpCode()
    Dim lastrow As Long
    Dim data As Variant
    Dim i As Long
    
    lastrow = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row
    data = ActiveSheet.Range("A7:CX" & lastrow).Value 'column 102-CX
    
    For i = 1 To UBound(data)
        If Not IsEmpty(data(i, 9)) Then
            data(i, 6) = "TEMPERATE"
            data(i, 11) = Split(data(i, 9), "-")(UBound(Split(data(i, 9), "-")))
            data(i, 34) = "Three_Layer_PE_or_PP"
            data(i, 38) = "N"
            data(i, 41) = "N"
            data(i, 45) = "Review by Process SME"
            data(i, 54) = "False"
            data(i, 55) = "1"
            data(i, 56) = "N"
            data(i, 70) = "Piping"
            data(i, 71) = "PIPE"
            data(i, 75) = "Criticality RBI Component - Piping"
            data(i, 76) = "Non Intrusive"
            data(i, 83) = "True"
            data(i, 84) = "True"
            data(i, 85) = "N"
            data(i, 87) = "N"
            data(i, 88) = "N"
            data(i, 89) = "Visual Detection"
            data(i, 90) = "Manual Shutdown"
            data(i, 91) = "Inventory blowdown"
            data(i, 96) = "100"
            data(i, 98) = "False"
            data(i, 102) = "False"
        ElseIf IsEmpty(data(i, 9)) Then
            data(i, 6) = ""
            data(i, 11) = ""
            data(i, 34) = ""
            data(i, 38) = ""
            data(i, 41) = ""
            data(i, 45) = ""
            data(i, 54) = ""
            data(i, 55) = ""
            data(i, 56) = ""
            data(i, 70) = ""
            data(i, 71) = ""
            data(i, 75) = ""
            data(i, 76) = ""
            data(i, 83) = ""
            data(i, 84) = ""
            data(i, 85) = ""
            data(i, 87) = ""
            data(i, 88) = ""
            data(i, 89) = ""
            data(i, 90) = ""
            data(i, 91) = ""
            data(i, 96) = ""
            data(i, 98) = ""
            data(i, 102) = ""
        End If
    Next i
    
    ActiveSheet.Range("A7:CX" & lastrow).Value = data
End Sub

huangapple
  • 本文由 发表于 2023年5月15日 09:37:15
  • 转载请务必保留本文链接:https://go.coder-hub.com/76250391.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定