Как сделать код VBA чище и с меньшим количеством очков?

Question

Я открываю файл для чтения ваших данных, но я думаю, что код слишком велик, он будет меньше или чище?

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

Answer 1

Вот еще один способ:

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

Было бы более гибким, если бы вы передали рабочую таблицу вместо рабочей книги: вы также можете передать массив заголовков в качестве аргумента, а затем функцию можно использовать повторно. для разных типов листов.

Answer 2

очень похоже на решение Тима, но с использованием Dicionary объекта

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

, как вы можете видеть, я также:

• предпочтительнее для передачи объекта листавместо книги, в которой с использованием какого-то листа

• не использовался nameInstitution, поскольку он не использовался в вашем коде

Как Тимуказал, что может быть предпочтительнее установить пары заголовок-адрес вне функции, которые будут принимать его в качестве параметра, например:

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

, где ваш "основной" код будет иметь что-то вроде:

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