Excel VBA宏-它可以简化或以不同的方式构建吗

Question

我制作了一个简单的VBA宏，在excel中打开的CSV文件上运行。该宏格式化工作表、删除某些数据、插入列等。然后，它将正确格式化的CSV复制到服务器，在服务器上将数据导入我们的ERP。CSV文件是物料清单，一切都很好。我想知道它是否可以简化。当我将此宏作为excel加载项导入时，它不会显示一个宏，而是显示宏中的所有各种子程序，以及按我需要的顺序调用所有其他子程序的主子程序。有没有更好的方法来排列这个代码？

Sub ProcessBOM()
Call DeleteColumn
Call DelBinFill
Call DelBlankRows
Call Insert3Columns
Call DelRow1
Call ClearColumns
Call InsertProjectName
Call InsertLineItemNo
Call InsertEA
Call MoveColumn
Call InsertDate
Call GetUserName
Call SaveAs
Call MessageBox
End Sub
'Delete first column
Sub DeleteColumn()
Columns(1).EntireColumn.Delete
End Sub
'Delete rows containing BIN FILL
Sub DelBinFill()
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "BIN FILL" Then Cells(i, 1).EntireRow.Delete
Next i
End Sub
'Delete rows with blank RDI Item #
Sub DelBlankRows()
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "" Then Cells(i, 1).EntireRow.Delete
Next i
End Sub
'Insert 3 blank columns
Sub Insert3Columns()
Range("A:C").EntireColumn.Insert
End Sub
'Delete Row 1
Sub DelRow1()
Rows(1).EntireRow.Delete
End Sub
'Clear Contents of specified columns
Sub ClearColumns()
Range("E:G").EntireColumn.Clear
End Sub
'Grabs Project Name from Active Sheet and inserts to last row
Sub InsertProjectName()
Dim LastRow As Long
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("C1:C" & LastRow) = ActiveSheet.Name
End Sub
'Insert Line Item Numbers
Sub InsertLineItemNo()
ActiveCell.FormulaR1C1 = "1"
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Selection.AutoFill Destination:=Range("A1:A" & LastRow), Type:=xlFillSeries
End Sub
'Insert EA Into Column E
Sub InsertEA()
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("E1:E" & LastRow) = "EA"
End Sub
' Moves QTY Data from H to F
Sub MoveColumn()
Columns("H:H").Select
Selection.Cut Destination:=Columns("F:F")
Columns("F:F").Select
End Sub
'Insert Date Into Column G
Sub InsertDate()
Dim LDate As String
LDate = Date
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("G1:G" & LastRow).Resize(, 2) = Array(Date, "=""""")
End Sub
'Get logged on username and insert into Column B
Sub GetUserName()
Dim strName As String
strName = Environ("UserName")
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("B1:B" & LastRow) = strName
End Sub
'Save file
Sub SaveAs()
Application.DisplayAlerts = False
MyName = ActiveSheet.Name
ActiveWorkbook.SaveAs Filename:="\navapp1svrboms$solidworksinbound" & "" & MyName & ".csv", FileFormat:=xlText
ActiveWorkbook.Saved = True
ActiveWorkbook.Close SaveChanges:=False
End Sub
'Prompt the user to verify data upload in Microsoft Dynamics NAV
Sub MessageBox()
MsgBox ("BOM upload complete.  Please check Dynamics for accuracy.")
End Sub

Answer 1

我认为这主要是基于意见的，但我在这里有一个强烈的意见，所以我分享它。我觉得你的代码被过度重构了，这里有一些多余的东西(变量被设置但从未使用过，.SELECT用于复制/粘贴，变量被声明和设置，然后只使用一次(

考虑一个单独的例程：

Sub ProcessBOM()
Dim i As Integer
'Delete first column
Columns(1).EntireColumn.Delete
'Delete rows containing BIN FILL or Nothing
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "BIN FILL" OR Cells(i, 1) = "" Then Cells(i, 1).EntireRow.Delete
Next i
'Insert 3 blank columns
Range("A:C").EntireColumn.Insert
'Delete Row 1
Rows(1).EntireRow.Delete
'Clear Contents of specified columns
Range("E:G").EntireColumn.Clear
'Define last used row
Dim LastRow As Long
LastRow = Range("D" & Rows.Count).End(xlUp).Row
'Grabs Project Name from Active Sheet and inserts to last row
Range("C1:C" & LastRow) = ActiveSheet.Name
'Insert Line Item Numbers
'What is this. How do you know what the "ActiveCell" is at this point or what is "Selected"
'Commenting out because this is risky. Explicitly set which cells you want to do this to
'ActiveCell.FormulaR1C1 = "1"
'Selection.AutoFill Destination:=Range("A1:A" & LastRow),Type:=xlFillSeries
'Insert EA Into Column E
Range("E1:E" & LastRow) = "EA"
' Moves QTY Data from H to F
Columns("H:H").Cut Destination:=Columns("F:F")
'Insert Date Into Column G
Range("G1:G" & LastRow).Resize(, 2) = Array(Date, "=""""")
'Get logged on username and insert into Column B
Range("B1:B" & LastRow) = Environ("UserName")
'Save file
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="\navapp1svrboms$solidworksinbound" & "" & ActiveSheet.Name & ".csv", FileFormat:=xlText   
ActiveWorkbook.Saved = True
ActiveWorkbook.Close SaveChanges:=False
'Prompt the user to verify data upload in Microsoft Dynamics NAV
MsgBox ("BOM upload complete.  Please check Dynamics for accuracy.")
End Sub

它只有54行，包括注释和空白。事实上，它只有23行实际的代码。每一步都很清楚在做什么，人类可以阅读它，而不会从最重要的程序跳到下一步。你真的很接近意大利面条代码，你不想去那里。

将其扩展为15个子例程并没有真正的意义，因为它们并没有真正封装超过一两行的代码，而且它们也不是非常可重用的，因为它们都对特定范围做了非常特定的事情，而这些事情只适用于代码运行时的单个时间点。如果您有更多的代码可能需要重用这里的一些代码，那么可以考虑将逻辑分离到自己的子例程中。

可能会将某些部分作为自己的子例程或函数。例如，您有两个类似于DelBinFill和DelBlankRows的例程。这些可以写成一个带有参数的单一例程：

Sub DelRows(criteria As String)
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = criteria Then Cells(i, 1).EntireRow.Delete
Next i
End Sub

并被称为：

Call DelRows("Bin Fill")
Call DelRows("")

但是。。。现在，您必须在同一范围内循环两次并删除行。循环一次(就像我上面做的那样(并基于这两个标准进行删除会更有效率。