VBA代码在执行期间阻塞计算机

时间:2017-06-27 14:25:37

标签: vba performance excel-vba parallel-processing excel

以下代码旨在运行工作簿中的工作表,并根据找到的标题执行计算。我遇到的问题是工作簿有时包含多达50张数据(有时)为2000行。这会在执行代码期间使计算机停滞不前。

有没有办法优化此代码,以便计算机不会陷入困境,或者我是否限制使用VBA进行此过程?谢谢!

以下是代码:

Option Explicit

Sub ReturnMarginal()

    Dim ws As Worksheet
    Dim lngLowLimCol As Long, strLowLimCol As String
    Dim lngHiLimCol As Long, strHiLimCol As String
    Dim lngMeasCol As Long, strMeasCol As String
    Dim lngLastRow As Long
    Dim wsf As WorksheetFunction

    ' get worksheetfunction references
    Set wsf = Application.WorksheetFunction

    ' iterate worksheets
    For Each ws In ThisWorkbook.Worksheets

        ' validate LowLimit label is on sheet
        If Not (ws.Rows(1).Find("LowLimit") Is Nothing) Then

        ' get location of input data columns and number of rows
        lngLowLimCol = wsf.Match("LowLimit", ws.Rows(1), 0)
        lngHiLimCol = wsf.Match("HighLimit", ws.Rows(1), 0)
        lngMeasCol = wsf.Match("MeasValue", ws.Rows(1), 0)
        lngLastRow = ws.Cells(1, lngLowLimCol).End(xlDown).Row

        ' get column letters for input data columns
        strLowLimCol = Split(ws.Cells(1, lngLowLimCol).Address(True, False), "$")(0)
        strHiLimCol = Split(ws.Cells(1, lngHiLimCol).Address(True, False), "$")(0)
        strMeasCol = Split(ws.Cells(1, lngMeasCol).Address(True, False), "$")(0)

        ' output headers
        ws.Range("P1") = "Meas-LO"
        ws.Range("Q1") = "Meas-Hi"
        ws.Range("R1") = "Min Value"
        ws.Range("S1") = "Marginal"

        ' assign formulas to outputs
        ' Meas-LO
        'Range("P2:P" & lngLastRow).Select
        '    With Selection
        '        Selection.NumberFormat = "General"
        '        .Value = .Value
        '    End With
        With ws.Range("P2:P" & lngLastRow)
            .Formula = "=IF(" & strLowLimCol & "2" = ""---"," & 
                strMeasCol & "2-" & strLowLimCol & "2," & _
                9999)"

        End With

        ' Meas-Hi
        With ws.Range("Q2:Q" & lngLastRow)
            .Formula = "=IF(ISNUMBER(" & strHiLimCol & "2)," & _
                strMeasCol & "2-" & strHiLimCol & "2," & _
                9999 & "2)"
                'strMeasCol & "2)"
        End With

        ' Min Value
        With ws.Range("R2:R" & lngLastRow)
            .Formula = "=MIN(P2,Q2)"
        End With

        ' Marginal
        With ws.Range("S2:S" & lngLastRow)
            .Formula = "=IF(AND(R2>=-3,R2<=3),""Marginal"",R2)"
        End With
        End If

    Next ws

End Sub

0 个答案:

没有答案