VBA Sub that Accepts large number of arguments - 最佳解析方式

VBA Sub that Accepts large number of arguments - Best way to parse

我在 VBA 中使用了很多 QueryTables.Add,它有大量的 parameters。我正在为这项任务“功能化”我的潜艇,我想我已经 运行 达到了 VBA 的限制,虽然我无法在网上找到确切的数字,但是当我试图所有参数都是可选的,我的编辑器变红了。当删除一些时,它变绿了,但我已经在考虑一种方法来制作一个可选的参数,它可能是某种 Param:Value 密钥对,然后我可以在 sub 中 split/parse/apply 。这也将允许我在未来使用它来使用希望代码更少的其他潜艇。我目前也没有操作许多 QueryTables 参数,但我想“面向未来”这个子。

这是我当前的 Sub Header,请注意 ' 如果您尝试添加最后一个参数,编辑器会变红。我正在寻找的是如何最好地处理的建议


Public Sub Query_Web_URL(URLStr As String, WSNameStr As String, Optional AdjustColumnWidth As String, Optional Application As String, Optional BackgroundQuery As String, Optional CommandText As String, Optional CommandType As String, Optional Creator As String, Optional EditWebPage As String, Optional EnableEditing As String, Optional EnableRefresh As String, Optional FetchedRowOverflow As String, Optional FieldNames As String, Optional FillAdjacentFormulas As String, Optional ListObject As String, Optional MaintainConnection As String, _
Optional Parameters As String, Optional Parent As String, Optional PostText As String, Optional PreserveColumnInfo As String, Optional PreserveFormatting As String, Optional QueryType As String, Optional Recordset As String, Optional Refreshing As String, Optional RefreshOnFileOpen As String, Optional RefreshPeriod As String, Optional RefreshStyle As String, Optional ResultRange As String, Optional RobustConnect As String, Optional RowNumbers As String, Optional SaveData As String, Optional SavePassword As String, Optional Sort As String, Optional SourceConnectionFile As String, Optional SourceDataFile As String, Optional TextFileColumnDataTypes As String, Optional TextFileCommaDelimiter As String, Optional TextFileConsecutiveDelimiter As String, _
Optional TextFileDecimalSeparator As String, Optional TextFileFixedColumnWidths As String, Optional TextFileOtherDelimiter As String, Optional TextFileParseType As String, Optional TextFilePlatform As String, Optional TextFilePromptOnRefresh As String, Optional TextFileSemicolonDelimiter As String, Optional TextFileSpaceDelimiter As String, Optional TextFileStartRow As String, Optional TextFileTabDelimiter As String, Optional TextFileTextQualifier As String, Optional TextFileThousandsSeparator As String, Optional TextFileTrailingMinusNumbers As String, _
Optional TextFileVisualLayout As String, Optional WebConsecutiveDelimitersAsOne As String, Optional WebDisableDateRecognition As String, Optional WebDisableRedirections As String, Optional WebFormatting As String, Optional WebPreFormattedTextToColumns As String, Optional WebSelectionType As String, Optional WebSingleBlockTextImport As String, Optional WebTables As String)  ' , Optional WorkbookConnection As String )


 Dim WS As Worksheet
 Call WorksheetCreateDelIfExists(WSNameStr)
 Set WS = Worksheets(WSNameStr)

 With WS.QueryTables.Add(Connection:="URL;" & URLStr, Destination:=Range("$A"))
  .Name = URLStr
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = False
  .RefreshOnFileOpen = False
  .BackgroundQuery = True
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .WebSelectionType = xlAllTables
  .WebFormatting = xlWebFormattingAll
  .WebPreFormattedTextToColumns = True
  .WebConsecutiveDelimitersAsOne = True
  .WebSingleBlockTextImport = False
  .WebDisableDateRecognition = False
  .WebDisableRedirections = False
  .Refresh BackgroundQuery:=False
 End With

End Sub

更新:

我现在明白了,该字符串可能要求我将某些参数转换为正确的类型,所以这将是第一个问题。事实上,我目前不需要传递很多参数,所以我的主要目标更重要的是,面向未来,这样我就可以添加更多参数而不会弄乱现有代码。

在这方面,我的问题是如何将变量作为可选变量传递,但如果未传递,则使用默认值,而不对每个可能的变量执行 If variable <> "" Then

拥有如此庞大数量的参数是完全没有意义的。很明显你的设计有问题。

选项 1: 为什么不创建一个 class?您无需传递大量参数,只需传递 class 的一个实例,在其中您将拥有所需的一切。

选项 2 : 为什么不将参数放入字典中?您将只向包含多个值的方法传递一个参数。

选项 3 : 为什么不简单地使用数组?

如果我了解您的要求,我会建议使用以下方法 Class:

Option Explicit

Private Sub Test()
   Dim Parms As QueryTableParameters
   
   'uses all default values
   Set Parms = New QueryTableParameters
   Query_Web_URL Parms
   
   'change some or all parms
   Set Parms = New QueryTableParameters
   Parms.URLStr = "I changed the default"
   Parms.BackgroundQuery = False
   Query_Web_URL Parms
End Sub

Private Sub Query_Web_URL(ByRef Parms As QueryTableParameters)
   'use the parms as needed
   Debug.Print Parms.BackgroundQuery
   Debug.Print Parms.URLStr
   Debug.Print Parms.WSNameStr
End Sub

这给出了以下输出:

这是实现这一目标的 class:

Option Explicit

'notice everything is typed correctly so no casting needed
Public URLStr As String
Public WSNameStr As String
Public BackgroundQuery As Boolean

Private Sub Class_Initialize()
   'set default values as needed
   URLStr = "default value"
   WSNameStr = "default value"
   BackgroundQuery = True
End Sub

这是我能想到的最佳方法,允许我使用默认值并添加参数,而无需真正调整代码,只需调整调用子程序。

示例 Class 命名为 clsQueryTables

Private Const xlAllTables = 2 ' All tables
Private Const xlEntirePage = 1 ' Entire page
Private Const xlSpecifiedTables = 3 ' Specified tables
Public WebSelectionType As Integer
Private Sub Class_Initialize()
    WebSelectionType = xlAllTables
End Sub

模块:

Public QueryArgs As New clsQueryTables

Sub Testing()
 Dim URLStr As String, WSNameStr As String
 URLStr = "http"
 WSNameStr = "Test"

 QueryArgs.WebSelectionType = xlAllTables
 Debug.Print "From Caller Sub QueryArgs.WebSelectionType = " & QueryArgs.WebSelectionType
 Call Query_Web_URL(URLStr, WSNameStr)
 
 QueryArgs.WebSelectionType = xlEntirePage
 Debug.Print "From Caller Sub QueryArgs.WebSelectionType = " & QueryArgs.WebSelectionType
 Call Query_Web_URL(URLStr, WSNameStr)
End Sub
Sub TestTwo()
 Dim URLStr As String, WSNameStr As String
 URLStr = "http"
 WSNameStr = "Test"
 Call Query_Web_URL(URLStr, WSNameStr)
End Sub

Public Sub Query_Web_URL(URLStr As String, WSNameStr As String)

 Dim WS As Worksheet
 Call WorksheetCreateDelIfExists(WSNameStr)
 Set WS = Worksheets(WSNameStr)

 With WS.querytables.Add(Connection:="URL;" & URLStr, Destination:=Range("$A"))
  .Name = URLStr
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = False
  .RefreshOnFileOpen = False
  .BackgroundQuery = True
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .WebSelectionType = QueryArgs.WebSelectionType
  .WebFormatting = xlWebFormattingAll
  .WebPreFormattedTextToColumns = True
  .WebConsecutiveDelimitersAsOne = True
  .WebSingleBlockTextImport = False
  .WebDisableDateRecognition = False
  .WebDisableRedirections = False
  .Refresh BackgroundQuery:=False
 End With

Debug.Print "From Sub QueryArgs.WebSelectionType = " & QueryArgs.WebSelectionType
End Sub

调试结果:

From Caller Sub QueryArgs.WebSelectionType = 2
From Sub QueryArgs.WebSelectionType = 2
From Caller Sub QueryArgs.WebSelectionType = 1
From Sub QueryArgs.WebSelectionType = 1
From Sub QueryArgs.WebSelectionType = 2