如何让 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
我正在打开一个文件来读取你的数据,但我觉得代码太大了,你能把它弄小一点还是更干净一点?
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