遍历Excel中的已定义列表

Question

I have an excel spreadsheet, with two defined lists. Call them colours{red, green, blue} and types{1, 2}

I have a function to calculate for each object, so finally, I have a table that looks like

colour type result

red 1 100

red 2 200

green 1 150

green 2 250

blue 1 155

blue 2 255

But obviously I wrote that by hand. Without using a VB script, is there any way I can get excel to fill in the colour and type cells to enumerate the whole set?

Thanks

Answer 1

Here's one VBA approach - you can pass in as many lists (by range) as you like and it will create all the combinations and copy them to where you specify.

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