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:="\\navapp1svr\boms$\solidworks\inbound" & "\" & 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:="\\navapp1svr\boms$\solidworks\inbound" & "\" & 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 行，包括 cmets 和 whitespace 。事实上，它只有 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("")

但是...现在您必须在同一范围内循环两次并删除行。循环一次（如我上面所做的那样）并根据这两个标准删除会更有效。