计算数据的更快方法VBA



我想知道在VBA中是否有更快的方法。我有100000多行的信息需要做这件事。我取直径和长度或高度,并将其转换为可用于计算周长的长度-宽度-高度。我知道屏幕更新,但我还能做些什么吗?也许case语句比and 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

下面是一个执行相同计算的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

最新更新