Question

我有一个excel电子表格，有两个已定义的列表。称它们为颜色{红色，绿色，蓝色}和类型{1,2}

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

的表

colour type result

红色1 100

红色2 200

green 1 150

绿色2 250

蓝色1 155

蓝色2 255

但显然我是手工写的。如果不使用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

在excel中迭代定义的列表

1 个答案: