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被用于复制/粘贴，声明并设置了变量，然后只使用了一次）< / p>

考虑一个例程：

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个子例程并没有多大意义，因为它们并没有真正封装多于一行或两行代码，而且它们都无法重用，因为它们都在特定范围内做着非常特定的事情这仅在代码运行时的单个时间点适用。如果您有更多代码可能需要重用此处提供的某些代码，则可以考虑将逻辑分离到自己的子例程中。

有些东西可能有其自身子程序或功能的意义。例如，您有两个类似于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("")

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

Excel VBA宏-是否可以简化或以不同的方式进行构造？

1 个答案: