划分动态列表vba

时间:2018-02-07 19:08:16

标签: excel vba excel-vba dynamic-programming

编辑:下面的解决方案帮助我将所有的select语句组合成一个字符串,但我最终使用了联合,因为我有太多的标签而SQL不会占用OR子句的数量。下面的确切解决方案可能会帮助那些元素较少的人。

我有一个动态字符串列表,我想分成4000个批次,所以我可以将这些4000组合成一个字符串。目前我有一个程序,假设最多有8000个项目,这使我错误,因为列表超出了这个范围。我在考虑在VBA中使用动态变量(我在C ++中学习过),但它不适用于VBA ...... tagcapture()用于从工作表列中获取项名称。 MaxTagPull是3999,用于计算第0个项目。

    For CurrentIndex = 2 To LastTagIndex
        If RegTagCount = 0 Then                                     ' If first regular tag in string
            String2 = "'" & tagcapture(1, CurrentIndex) & "'"
            String3 = String3 & String2
        End If
        If RegTagCount > 0 And RegTagCount < MaxTagPull Then        ' If second tag and up until max number of tags allowed in one query string
            String2 = ", '" & tagcapture(1, CurrentIndex) & "'"
            String3 = String3 & String2
        End If
        If RegTagCounter = MaxTagPull Then                          ' Put the rest of the regular tags in a separate string
            String4 = "'" & tagcapture(1, CurrentIndex) & "'"
            String5 = String5 & String4
        End If
        If RegTagCounter > MaxTagPull Then                          ' Put the rest of the regular tags in a separate string
            String4 = ", '" & tagcapture(1, CurrentIndex) & "'"
            String5 = String5 & String4
        End If
        RegTagCount = RegTagCount + 1                               ' Counts the amount of regular tags encountered


    Next

如何修改它以便它可以容纳动态列表?也许使用函数或其他子? 请注意,项目总数是已知的,所以也许可以用它做点什么?

谢谢

1 个答案:

答案 0 :(得分:1)

这不是您提出的确切问题,但我认为它符合您的最终目标:

Sub Tester()
    Debug.Print SQLInClause(Range("B3:B29"), "myFieldName", False)
End Sub

'Given a single-column range "rng", convert the content to a SQL "in" clause,
'  with a maximum number of items per "in" block, with blocks joined by "or"
'  Use the SQL field name supplied in "fName"
'  "isChar" determines whether to quote the values
Function SQLInClause(rng As Range, fName As String, isChar As Boolean) As String

    Const MAX_PER_BLOCK As Long = 10 '<<10 for testing: set to 4000 for production use...

    Dim sql As String, arr(), i As Long, n As Long
    Dim d, sep, qt, tot As Long


    d = rng.Value
    tot = UBound(d, 1)
    i = 0      'counter for each block
    qt = IIf(isChar, "'", "") '<< set quote character (or none)
    sep = ""
    ReDim arr(1 To MAX_PER_BLOCK)

    For n = 1 To tot
        'any value to add?
        If Len(d(n, 1)) > 0 Then
            i = i + 1 
            arr(i) = d(n, 1)

            'are we at the end of a block, or at the end of the list?
            If i = MAX_PER_BLOCK Or n = tot Then

                'if at the end of the list, resize array to trim off empty elements
                If n = tot Then ReDim Preserve arr(1 To i)

                sql = sql & sep & fName & " in(" & qt & Join(arr, qt & "," & qt) & qt & ")"
                sep = vbCrLf & " or " '<< "or" is set after first block
                i = 0
            End If
        End If
    Next n
    SQLInClause = sql
End Function

示例输出(格式化一点):

myFieldName in('Val0001','Val0002','Val0003','Val0004','Val0005','Val0006',
               'Val0007','Val0008','Val0009', 'Val0010') 
or myFieldName in('Val0011','Val0012','Val0013','Val0014','Val0015','Val0016',
      'Val0017','Val0018','Val0019', 'Val0020') 
or myFieldName in('Val0021','Val0022','Val0023','Val0024','Val0025','Val0027')