如何让 VBA 的代码更干净,点数更少?

How do I make VBA code cleaner and with less points?

我正在打开一个文件来读取你的数据,但我觉得代码太大了,你能把它弄小一点还是更干净一点?

Private Function HeaderValidation(workbook As Workbook, nameInstitution As String) As String
Dim mensage As String
Dim headersTranslator(5) As String
Dim headers(5) As String
Dim i As Integer

headers(0) = workbook.Worksheets(1).Range("B5").value
headers(1) = workbook.Worksheets(1).Range("A2").value
headers(2) = workbook.Worksheets(1).Range("F5").value
headers(3) = workbook.Worksheets(1).Range("E5").value
headers(3) = workbook.Worksheets(1).Range("G5").value

headersTranslator(0) = "Client (B5)"
headersTranslator(1) = "back (A2)"
headersTranslator(2) = "ATM (F5)"
headersTranslator(3) = "ValueInsert (E5)"
headersTranslator(3) = "DM (G5)"

For i = 0 To UBound(headersTranslator) - 1
    If Left(headersTranslator(i), Len(headersTranslator(i)) - 5) <> headers(i) Then
        mensage = mensage & headersTranslator(i)
        If i <> UBound(headersTranslator) - 1 Then
            mensage = mensage & ", "
        End If
    End If
Next i
HeaderValidation = mensage

End Function

我想修复 Workbook.Worksheets(1).Range("B5").Value

这是另一种方式:

Private Function HeaderValidation(Workbook As Workbook) As String
    Dim mensage As String, arr, h

    For Each h In Array("Client|B5", "back|A2", "ATM|F5", _
                        "ValueInsert|E5", "DM|G5")
        arr = Split(h, "|")
        If arr(0) <> Workbook.Worksheets(1).Range(arr(1)).Value Then
            mensage = mensage & IIf(mensage <> "", vbLf, "") & _
                      arr(0) & " not found at " & arr(1)
        End If
    Next h
    HeaderValidation = mensage
End Function

如果你传入一个工作sheet而不是一个工作簿会更灵活:你也可以传入header数组作为参数,然后该函数可以在不同的环境中重复使用sheet 种类型。

与 Tim 的解决方案非常相似,但使用了 Dicionary object

Private Function HeaderValidation(sht As Worksheet) As String
    Dim message As String, key As Variant

    With CreateObject("Scripting.Dictionary")
        .Add "B5", "Client"
        .Add "A2", "back"
        .Add "F5", "ATM"
        .Add "E5", "ValueInsert"
        .Add "G6", "DM"

        For Each key In .Keys
            If sht.Range(key).Value2 <> .Item(key) Then message = message & .Item(key) & " (" & key & ")" & vbNewLine
        Next
    End With
    HeaderValidation = message
End Function

如你所见我也:

  • 更喜欢通过工作sheet object而不是使用一些sheet

  • 的工作簿
  • 没有使用 nameInstitution 因为它没有在您的代码中使用

正如 Tim 指出的那样,最好在接受它作为参数的函数外部设置 header-address 对,如下所示:

Private Function HeaderValidation(sht As Worksheet, dict As Object) As String
    Dim message As String, key As Variant

    With dict
        For Each key In .Keys
            If sht.Range(key).Value2 <> .Item(key) Then message = message & .Item(key) & " (" & key & ")" & vbNewLine
        Next
    End With
    HeaderValidation = message
End Function

您的 "main" 代码应该是这样的:

Sub main()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add "B5", "Client"
        .Add "A2", "back"
        .Add "F5", "ATM"
        .Add "E5", "ValueInsert"
        .Add "G6", "DM"
    End With

    (any code)    

    MsgBox HeaderValidation2(ActiveSheet, dict)

    (any code)

End Sub