Excel VBA 处理一个参数的 64 个值

Question

我正在尝试运行一个 VBA 脚本，该脚本将传入的电子邮件读取到帐户，然后在电子表格中标记相应的单元格。我的测试运行有 9 个作业，它在嵌套 IF 语句中寻找。

像这样:

  If InStr(itm.subject, "Test Backup") > 0 Then 
    J = 2
    ElseIf InStr(itm.subject, "TESTdchq") > 0 Then 
        J = 3
    ElseIf InStr(itm.subject, "TESTdynamics") > 0 Then 
        J = 4
    ElseIf InStr(itm.subject, "TEST-VSS-HQ") > 0 Then 
        J = 5
    ElseIf InStr(itm.subject, "TESTWSUS01") > 0 Then 
        J = 6
    ElseIf InStr(itm.subject, "TEST-Camera") > 0 Then 
        J = 7
    ElseIf InStr(itm.subject, "TEST-Vcenter") > 0 Then 
        J = 8
    ElseIf InStr(itm.subject, "TEST-View Connection") > 0 Then 
        J = 9
    ElseIf InStr(itm.subject, "TESTktsrv1") > 0 Then 
        J = 10
  End If

然而，我的一个实际应用程序有 64 个工作。我需要一种更有效的方法来根据电子邮件主题中的关键字将值分配给 J。我假设我可以对数组做一些事情，然后调用该数组并与主题进行比较。

如果有帮助的话，这是整个测试脚本。

Sub ReconcileTest(itm As Outlook.MailItem)

  Dim xlApp As Excel.Application
  Dim ExcelWkBk As Excel.Workbook
  Dim FileName As String
  Dim PathName As String
  Dim J As Integer
  'J = will be used to declare the proper Job row

  PathName = "C:\Users\Owner\Dropbox\Backups\"
  FileName = "TESTReconcileSheet.xlsx"
  'Declare J
  If InStr(itm.subject, "Test Backup") > 0 Then 
    J = 2
    ElseIf InStr(itm.subject, "TESTdchq") > 0 Then 
        J = 3
    ElseIf InStr(itm.subject, "TESTdynamics") > 0 Then 
        J = 4
    ElseIf InStr(itm.subject, "TEST-VSS-HQ") > 0 Then 
        J = 5
    ElseIf InStr(itm.subject, "TESTWSUS01") > 0 Then 
        J = 6
    ElseIf InStr(itm.subject, "TEST-Camera") > 0 Then 
        J = 7
    ElseIf InStr(itm.subject, "TEST-Vcenter") > 0 Then 
        J = 8
    ElseIf InStr(itm.subject, "TEST-View Connection") > 0 Then 
        J = 9
    ElseIf InStr(itm.subject, "TESTktsrv1") > 0 Then 
        J = 10
  End If

  Set xlApp = Application.CreateObject("Excel.Application")
  With xlApp
    .Visible = True         ' Visible is used for debugging
    Set ExcelWkBk = xlApp.Workbooks.Open(PathName & FileName)
    With ExcelWkBk

      'VBA code to update workbook here
      Dim todaysDate As Date
      Dim D As Integer    
      Dim subject As String
      'D = will be used to declare the proper Date column

      todaysDate = Day(Now)
      D = todaysDate
      'Marksheet
      If InStr(itm.subject, "[Success]") > 0 Then
      .Sheets("sheet1").Cells(J, (D + 2)).Value = "S"
      .Sheets("Sheet1").Cells(J, (D + 2)).Interior.ColorIndex = 43
      ElseIf InStr(itm.subject, "[Failed]") > 0 Then
      .Sheets("sheet1").Cells(J, (D + 2)).Value = "F"
      .Sheets("Sheet1").Cells(J, (D + 2)).Interior.ColorIndex = 3
      ElseIf InStr(itm.subject, "[Warning]") > 0 Then
      .Sheets("sheet1").Cells(J, (D + 2)).Value = "W"
      .Sheets("Sheet1").Cells(J, (D + 2)).Interior.ColorIndex = 27
      End If

      .Save
      .Close
    End With
    .Quit
  End With
End Sub

Answer 1

我建议对如此大量的变量使用字典。如果需要，您可以创建全局字典，但以下示例是在本地完成的:

Dim dict As New Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")

dict.Add "Test Backup", 2
dict.Add "TESTdchq", 3
dict.Add "TESTdynamics", 4
dict.Add "TEST-VSS-HQ", 5
dict.Add "TESTWSUS01", 6
dict.Add "TEST-Camera", 7
dict.Add "TEST-Vcenter", 8
dict.Add "TEST-View Connection", 9
dict.Add "TESTktsrv1", 10

Dim J As Integer
J = dict(itm.Subject)

MsgBox "J = " & J

---

结果: