计算数据VBA的更快方法

Question

我想知道在VBA中是否有更快的方法来做到这一点。我有100,000余行信息，我需要这样做。我将直径与长度或高度一起计算，并将其转换为可用于计算周长的长度，宽度，高度。我知道有关屏幕更新的信息，但是我还能做些其他事情吗？也许case语句比If语句更好。至少需要30分钟才能运行。

谢谢。

     Sub Diamater()


'Range of all rows in column D where there is Data
    lRowA = Range("A" & Rows.Count).End(xlUp).Row
    Set ColumnA = Range("A2:A" & lRowA)
DoEvents
'Loops through every cell in Column A
    For Each cell In ColumnA
DoEvents
        Dim A As Range
        Dim B As Range
        Dim C As Range
        Dim D As Range
        Dim E As Range
        Dim F As Range
        Dim G As Range
        Dim H As Range
        Dim I As Range
        Dim J As Range
        Dim K As Range
        Dim L As Range
        Dim M As Range
        Dim N As Range
        Dim O As Range
        Dim P As Range
        Dim Q As Range
        Dim R As Range
        Dim S As Range
        Dim T As Range
        Dim U As Range
        Dim V As Range
        Dim W As Range
        Dim X As Range
        Dim Y As Range
        Dim Z As Range
        Dim AA As Range
        Dim AB As Range
        Dim AC As Range
        Dim AD As Range
        Dim AE As Range
        Dim AF As Range
        Dim AG As Range
        Dim AH As Range
        Dim AI As Range
    Set A = cell
    Set B = cell.Offset(0, 1)
    Set C = cell.Offset(0, 2)
    Set D = cell.Offset(0, 3)
    Set E = cell.Offset(0, 4)
    Set F = cell.Offset(0, 5)
    Set G = cell.Offset(0, 6)
    Set H = cell.Offset(0, 7)
    Set I = cell.Offset(0, 8)
    Set J = cell.Offset(0, 9)
    Set K = cell.Offset(0, 10)
    Set L = cell.Offset(0, 11)
    Set M = cell.Offset(0, 12)
    Set N = cell.Offset(0, 13)
    Set O = cell.Offset(0, 14)
    Set P = cell.Offset(0, 15)
    Set Q = cell.Offset(0, 16)
    Set R = cell.Offset(0, 17)
    Set S = cell.Offset(0, 18)
    Set T = cell.Offset(0, 19)
    Set U = cell.Offset(0, 20)
    Set V = cell.Offset(0, 21)
    Set W = cell.Offset(0, 22)
    Set X = cell.Offset(0, 23)
    Set Y = cell.Offset(0, 24)
    Set Z = cell.Offset(0, 25)
    Set AA = cell.Offset(0, 26)
    Set AB = cell.Offset(0, 27)
    Set AC = cell.Offset(0, 28)
    Set AD = cell.Offset(0, 29)
    Set AE = cell.Offset(0, 30)
    Set AF = cell.Offset(0, 31)
    Set AG = cell.Offset(0, 32)
    Set AH = cell.Offset(0, 33)
    Set AI = cell.Offset(0, 34)

    Dim ITEM_ID As Range
    Dim ITEM_NAME As Range
    Dim BU_CODE_DT As Range
    Dim BU_CODE_SUP As Range
    Dim Box_Count_Number As Range
    Dim PA_NO As Range
    Dim PACK_QTY_ART As Range
    Dim EVER_RECEIVED As Range
    Dim PARCEL_CODE As Range
    Dim PARCEL_RESTRICTION_TYPE As Range
    Dim Gemini_Restrict As Range
    Dim Supplier_Count As Range
    Dim Restriction_Count As Range
    Dim Supplier_Not_Restricted As Range
    Dim All_CDC_Suppliers As Range
    Dim All_CDC_Restrictions As Range
    Dim Supplier_Not_Restricted_All As Range
    Dim CLG_Calc As Range
    Dim CLG_Oversized As Range
    Dim Additional_Handling As Range
    Dim CLG_Calc_With_Tolerance As Range
    Dim CLG_Oversize_With_Tolelrance As Range
    Dim Additional_Handling_With_Tolerance As Range
    Dim ITEM_LEN As Range
    Dim ITEM_WID As Range
    Dim ITEM_HEI As Range
    Dim ITEM_WEI_GRO As Range
    Dim Dimentional_Weight As Range
    Dim Girth As Range
    Dim DWP_Length As Range
    Dim DWP_Width As Range
    Dim DWP_Height As Range
    Dim DWP_Diameter As Range
    Dim DWP_Gross_Weight As Range
    Dim DWP_Girth As Range



    Set ITEM_ID = A
    Set ITEM_NAME = B
    Set BU_CODE_DT = C
    Set BU_CODE_SUP = D
    Set Box_Count_Number = E
    Set PA_NO = F
    Set PACK_QTY_ART = G
    Set EVER_RECEIVED = H
    Set PARCEL_CODE = I
    Set PARCEL_RESTRICTION_TYPE = J
    Set Gemini_Restrict = K
    Set Supplier_Count = L
    Set Restriction_Count = M
    Set Supplier_Not_Restricted = N
    Set All_CDC_Suppliers = O
    Set All_CDC_Restrictions = P
    Set Supplier_Not_Restricted_All = Q
    Set CLG_Calc = R
    Set CLG_Oversized = S
    Set Additional_Handling = T
    Set CLG_Calc_With_Tolerance = U
    Set CLG_Oversize_With_Tolelrance = V
    Set Additional_Handling_With_Tolerance = W
    Set ITEM_LEN = X
    Set ITEM_WID = Y
    Set ITEM_HEI = Z
    Set ITEM_WEI_GRO = AA
    Set Dimentional_Weight = AB
    Set Girth = AC
    Set DWP_Length = AD
    Set DWP_Width = AE
    Set DWP_Height = AF
    Set DWP_Diameter = AG
    Set DWP_Gross_Weight = AH
    Set DWP_Girth = AI

    'Takes the Diameter and places it in the Length and Widthh Column if there is a Height and Diameter
    If DWP_Diameter > 1 And DWP_Height > 1 And DWP_Length < 1 Then
        DWP_Length.Value = DWP_Diameter.Value
        DWP_Width.Value = DWP_Diameter.Value
    End If

    'Takes the Diameter and places it in the Hieght and Widthh Column if there is a Length and Diameter
    If DWP_Diameter > 1 And DWP_Height < 1 Then

        DWP_Height.Value = DWP_Diameter.Value
        DWP_Width.Value = DWP_Diameter.Value

    End If

    'If the length is less than diameter switch the length to hieght and height to length
    If DWP_Diameter > 1 And DWP_Length < DWP_Height Then

        DWP_Height.Value = DWP_Length.Value

        DWP_Length.Value = DWP_Diameter.Value

    End If

    If DWP_Diameter > 1 And DWP_Girth = "" Then
        DWP_Girth = ((2 * DWP_Height) + (2 * DWP_Width) + DWP_Length)
    End If



Next

Answer 1

这是一个示例SQL查询，它将执行相同的计算。这应该快得多，以使数据库能够做自己擅长的事情（处理数据行）。允许Excel做自己擅长的工作（数据可视化，聚合/枢轴计算，复杂的非关系计算，统计信息等）：

SELECT
        Item_Id,
        Diameter,
        Width,
        IIF(testLength < testHeight, testHeight, testLength) AS Length,
        IIF(testLength < testHeight, testLength, testHeight) AS Height,
        IIF(Diameter > 1 AND Girth IS NULL, ((2 * Height) + (2 * Width) + Length)), Girth) As Girth
    From
        (
            SELECT
                Item_ID,
                IIF(Diameter > 1, Width = Diameter, Width) as Width, 
                IIF(Diameter > 1 AND Height > 1 AND Length < 1, Length = Diameter, Length)as testLENGTH,
                IIF(Diameter > 1 AND Height < 1, Height = Diameterm Height) AS testHeight
                Diameter,
                Girth
            From yourTable
        ) AS interim_calculation