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行,包括注释和空格.实际上,它只有23行实际代码.很清楚每个步骤正在做什么,它可以被人类阅读,而不会从顶级例程反弹到接下来的任何步骤.你真的很接近意大利面条代码,你不想去那里.

将它扩展为15个子程序并不真正有意义,因为它们实际上并没有真正封装一行或两行代码,并且它们不是非常可重复使用,因为它们都对特定范围执行了非常特定的操作在代码运行时适用于单个时间点.如果你有更多的代码可能需要重用这里存在的一些代码,那么MAYBE可以考虑将逻辑分离到它自己的子程序中.

有些部分可能作为自己的子程序或功能有意义.例如你有两个例程是相似的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("")

但是......现在你必须两次遍历相同的范围并删除行.循环一次(如上所述)并基于两个标准删除将更有效.