VBA SQL 二维表转一维表

Excel VBA练习 2021-07-15

435

今天在群里有看到网友发的一道题

如下图所示

这是一份网友给出的数据

现如今需要转化为一维表好做下一步的分析

如果使用Power Query逆透视即可转化为一维表

上载即可或者加载到透视表

如果使用SQL就需要用到循环字段连接字符串,连接成SQL语句

这里就需要之前所讲的

VBA SQL Union 合并数据

先上代码

Sub GetData(control As IRibbonControl)
    Dim Conn As Object, Rec As Object, Sht As Worksheet
    Dim aField, aData, intx&, S$, intY&
    Dim strSQL$, strSource$
    On Error Resume Next
    Set Conn = CreateObject("Adodb.Connection")
    If Application.Version < 12 Then '判断Excel的版本号,以使用不同的连接字符串
        Conn.Open "Provider=Microsoft.ACE.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes;IMEX=0';Data Source=" & ThisWorkbook.FullName
    Else
        Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=0';Data Source=" & ThisWorkbook.FullName
    End If


    strSource = "[成绩表$A1:K1022]" '数据来源区域
    aData = Range("a1").CurrentRegion


    For intY = 7 To 11
        S = ""
        For intx = 1 To 6
            S = S & aData(1, intx) & ","
        Next        
        S = "Select " & S & "'" & aData(1, intY) & "'" & " As 学科," & aData(1, intY) & " As 分数 From " & strSource & " Union All "
        strSQL = strSQL & S
    Next
    strSQL = Left(strSQL, Len(strSQL) - Len("Union All ")) & " Order By 序号"
     
    Set Rec = Conn.Execute(strSQL)


    ReDim aField(1 To Rec.Fields.Count) 'Fields包含了所有字段的,Fields.Count 得到字段的数量
    For intx = 0 To Rec.Fields.Count - 1 'Fields.Count的下标为0,因此总数-1,字段数组从1开始,所以每次都需要+1
        aField(intx + 1) = Rec.Fields(intx).Name
    Next


    Range("M1").Resize(, UBound(aField)) = aField '写入字段
    Range("m2").CopyFromRecordset Rec '使用单元格CopyFromRecordset方法将Rec记录写入到指定单元格


    Conn.Close '关闭连接
    Set Conn = Nothing '释放
    Set Rec = Nothing '释放
End Sub

代码的核心就第16至24行循环遍历数据源标题,连接字符串合成SQL语句

第一遍循环连接成以下字符串

Select 序号,年级,班级,考场,考号,姓名,'语文' As 学科,语文 As 分数 From [成绩表$A1:K1022] Union All

也就是常规的查询语句

第二遍循环在此连接

Select 序号,年级,班级,考场,考号,姓名,'语文' As 学科,语文 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'数学' As 学科,数学 As 分数 From [成绩表$A1:K1022] Union All

依次类推,不停的开火车

最终连接成

Select 序号,年级,班级,考场,考号,姓名,'语文' As 学科,语文 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'数学' As 学科,数学 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'英语' As 学科,英语 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'科学' As 学科,科学 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'品社' As 学科,品社 As 分数 From [成绩表$A1:K1022] Union All

连接完成后,在结尾出多了"Union All"的字符串,来利用左截取"Left",截取所需的部分,在此连接Order By 语句做排序 ,最终形成了SQL语句

如果想做成类似透视表那样的交叉表,就需要使用TransForm语句

其语法如下

TransForm 聚合值字段 Select 行字段 From 表 Group By 分组行字段 Pivot 列字段 [In Value...

    For intY = 7 To 11
        S = ""
        For intx = 1 To 6
            S = S & aData(1, intx) & ","
        Next
        S = "Select " & S & "'" & aData(1, intY) & "'" & " As 学科," & aData(1, intY) & " As 分数 From " & strSource & " Union All "
        strSQL = strSQL & S
    Next
    S = Left(strSQL, Len(strSQL) - Len("Union All "))
    strSQL = "TransForm Sum(分数) Select 年级,班级 From (" & S & ") Group By 年级,班级 pivot 学科"

循环连接形成以下SQL语句

TransForm Sum(分数) 
Select 年级,班级 From
 (Select 序号,年级,班级,考场,考号,姓名,'语文' As 学科,语文 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'数学' As 学科,数学 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'英语' As 学科,英语 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'科学' As 学科,科学 As 分数 From [成绩表$A1:K1022] Union All 
Select 序号,年级,班级,考场,考号,姓名,'品社' As 学科,品社 As 分数 From [成绩表$A1:K1022] ) 
Group By 年级,班级 
pivot 学科

关于TransForm语句我们明天聊

示例文件下载

链接：https://pan.baidu.com/s/1yWvNCTlwtYCvqWirK4tvHw

提取码：abcd

收工!

如果小伙伴有好的思路,可以在小编的公众号留言发给小编研究下

文章觉得有用,点个赞+在看,你的每一次点赞和转发就是小编原创的动力

关注公众号 ↓

数据库

文章转载自Excel VBA练习，如果涉嫌侵权，请发送邮件至：contact@modb.pro进行举报，并提供相关证据，一经查实，墨天轮将立刻删除相关内容。

VBA SQL 二维表转一维表

评论