遍历Excel中的已定义列表

Question

我有一个Excel电子表格，其中包含两个已定义的列表。 称其为颜色{红色，绿色，蓝色}和类型{1、2}

我有一个为每个对象计算的函数，所以最后，我有一个表，看起来像

colour type result

红色1100

红色2200

绿色1150

绿色2250

蓝色1155

蓝色2255

但是显然我是手工写的。 如果不使用VB脚本，有什么办法可以使Excel填写颜色并键入单元格以枚举整个集合？

谢谢

Answer 1

这是一种VBA方法-您可以根据需要传入任意数量的列表（按范围），它将创建所有组合并将其复制到您指定的位置。

Sub tester()

    'First range is where to place the results, next ranges
    '  are the lists to be combined
    SqlPermutate Sheet1.Range("E1"), Sheet1.Range("A1:A20"), _
                 Sheet1.Range("B1:B5"), Sheet1.Range("C1:C10")

End Sub


Sub SqlPermutate(rngDestination As Range, ParamArray ranges() As Variant)

    Dim oConn As Object, oRS As Object
    Dim sPath, i As Long, srcWb As Workbook
    Dim sSQL As String, flds As String, tbls As String

    'check source ranges are in a saved workbook...
    Set srcWb = ranges(0).Parent.Parent
    If srcWb.Path <> "" Then
      sPath = srcWb.FullName
    Else
      MsgBox "Workbook being queried must be saved first..."
      Exit Sub
    End If

    For i = LBound(ranges) To UBound(ranges)
        flds = flds & IIf(Len(flds) > 0, ",", "") & Chr(65 + i) & ".*"
        tbls = tbls & IIf(Len(tbls) > 0, ",", "") & _
                RngNm(ranges(i)) & " " & Chr(65 + i)
    Next i

    sSQL = "select " & flds & " from " & tbls
    Debug.Print sSQL

    Set oConn = CreateObject("adodb.connection")
    Set oRS = CreateObject("ADODB.Recordset")

    oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sPath & "';" & _
                 "Extended Properties='Excel 12.0;HDR=no;IMEX=1';"

    oRS.Open sSQL, oConn

    If Not oRS.EOF Then
        rngDestination.CopyFromRecordset oRS
    Else
        MsgBox "No records found"
    End If

    oRS.Close
    oConn.Close

End Sub

Function RngNm(r) As String
    RngNm = "[" & r.Parent.Name & "$" & _
                r.Address(False, False) & "]"
End Function