1. 程式人生 > >利用Excel VBA實現批量資料分組轉置

利用Excel VBA實現批量資料分組轉置


問題:如上圖所示,按lon,lat分組,再進行轉置。

Sub admin()
    Dim conn, xRs, xFd
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.Jet.Oledb.4.0;" & _
              "Extended Properties= 'Excel 8.0;hdr=yes;IMEX=1' ;" & _
              "Data Source=" & ThisWorkbook.FullName
    Set xRs = CreateObject("ADODB.RecordSet")
        sSql = " Transform Sum( [Tas_t] ) Select [lon] , [lat] From [Sheet1$A:D] Group By [lon] , [lat] Pivot [Year] "
        xRs.Open sSql, conn, 1, 3
        i = 0
        For Each xFd In xRs.Fields
            Range("F1").Offset(0, i) = xFd.Name
            i = i + 1
        Next
        Range("F2").CopyFromRecordset xRs
        xRs.Close
        conn.Close
    Set xRs = Nothing
    Set conn = Nothing
End Sub