设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel数据透视表 › SQL转置练习，转置九式。【开贴】
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器，一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理，一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
1 ...789101112131415... 56下一页
返回列表 发新帖
楼主: wuxiang_123

[原创] SQL转置练习，转置九式。【开贴】

  [复制链接]
danishman

TA的精华主题

TA的得分主题
发表于 2012-3-21 09:29 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
好有难度的东西啊，学习学习
回复

举报

michaelli23

TA的精华主题

TA的得分主题
发表于 2012-3-21 11:54 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
受益匪浅，顶！
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:40 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
本帖最后由 香川群子 于 2012-3-21 16:41 编辑
bluexuemei 发表于 2012-2-4 10:00
关于转置，本人是一片空白，不知道哪里有介绍。


用VBA内存数组，for……next……循环方式做了全部转置九题。

请看附件：
VBA Transpose.zip (26.47 KB, 下载次数: 118)



转置-1 要求：二维数组转置为 一行显示。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 4 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To 1, 1 To m * 2)
  7.         For i = 1 To m
  8.             brr(1, i * 2 - 1) = arr(i, 1)
  9.             brr(1, i * 2) = arr(i, 2)
  10.         Next
  11.         Target.Resize(, m * 2) = brr
  12.     End If
  13. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:43 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
转置-2 要求： 二维表数据转置为3列数据显示（实际3”2=6列）
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 13 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         n = (m * 2 - 1) \ 6
  7.         ReDim brr(n, 1 To 6)
  8.         For i = 0 To n
  9.             For j = 1 To 3
  10.                 t = i * 6 / 2 + j
  11.                 If t > m Then GoTo Ext
  12.                 brr(i, j * 2 - 1) = arr(t, 1)
  13.                 brr(i, j * 2) = arr(t, 2)
  14.             Next
  15.         Next
  16. Ext:
  17.         Target.Resize(n + 1, 6) = brr
  18.     End If
  19. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
转置-3 要求： 二维表 按行提取相同项目，逐列展开数据。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 8 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m, 1 To m * 2)
  7.         For i = 1 To m
  8.             For j = 1 To m
  9.                 If arr(i, 1) = brr(j, 1) Or brr(j, 1) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m * 2 Step 2
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, K) = arr(i, 1)
  15.                             brr(j, K + 1) = arr(i, 2)
  16.                             GoTo Nxt
  17.                         End If
  18.                     Next
  19.                 End If
  20.             Next
  21. Nxt:
  22.         Next
  23.         Target.Resize(l, n + 1) = brr
  24.     End If
  25. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:47 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
转置-4 要求： 二维表数据，同样按行展开相同项目，但仅第一列表示项目名称，后面各列只显示数据。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 8 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m, m)
  7.         For i = 1 To m
  8.             For j = 1 To m
  9.                 If arr(i, 1) = brr(j, 0) Or brr(j, 0) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, 0) = arr(i, 1)
  15.                             brr(j, K) = arr(i, 2)
  16.                             GoTo Nxt
  17.                         End If
  18.                     Next
  19.                 End If
  20.             Next
  21. Nxt:
  22.         Next
  23.         Target.Resize(l, n + 1) = brr
  24.     End If
  25. End Sub

复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:53 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
转置-5 要求： 二维数据表 隔行展开相同项目(即数据之间空一行)，第1列为项目名称，以后逐列展开数据内容。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 12 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m * 2, m)
  7.         For i = 1 To m
  8.             For j = 1 To m * 2 Step 2
  9.                 If arr(i, 1) = brr(j, 0) Or brr(j, 0) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, 0) = arr(i, 1)
  15.                             brr(j, K) = arr(i, 2)
  16.                             GoTo Nxt
  17.                         End If
  18.                     Next
  19.                 End If
  20.             Next
  21. Nxt:
  22.         Next
  23.         Target.Resize(l, n + 1) = brr
  24.     End If
  25. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 16:59 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
转置-6 要求：  二维数据表，隔行按照项目名称展开，
第一行为数据，其中第1列为项目名，第2列开始为数据内容。
第二行插入了数据个数，即总共(n人)的合计内容。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 13 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m * 2, m)
  7.         For i = 1 To m
  8.             For j = 1 To m * 2 Step 2
  9.                 If arr(i, 1) = brr(j, 0) Or brr(j, 0) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, 0) = arr(i, 1)
  15.                             brr(j, K) = arr(i, 2)
  16.                             brr(j + 1, 0) = brr(j + 1, 0) + 1
  17.                             GoTo Nxt
  18.                         End If
  19.                     Next
  20.                 End If
  21.             Next
  22. Nxt:
  23.         Next
  24.         For j = 1 To l Step 2
  25.             brr(j + 1, 0) = ChrW(24635) & ChrW(20849) & "(" & brr(j + 1, 0) & ChrW(20154) & ")"

  27.         Next
  28.         Target.Resize(l + 1, n + 1) = brr
  29.     End If
  30. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 17:01 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
转置-7 要求： 二维数据表 按项目名称展开，第1列为项目名称，第2-4列共3列为数据内容。
即，列数据按照最大3列进行折叠式展开。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 14 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m, m)
  7.         For i = 1 To m
  8.             For j = 1 To m
  9.                 If arr(i, 1) = brr(j, 0) Or brr(j, 0) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, 0) = arr(i, 1)
  15.                             brr(j, K) = arr(i, 2)
  16.                             GoTo Nxt
  17.                         End If
  18.                     Next
  19.                 End If
  20.             Next
  21. Nxt:
  22.         Next
  23.         ReDim brr2(1 To m, -1 To 2)
  24.         K = 0
  25.         For i = 1 To l
  26.             brr2(K + 1, -1) = brr(i, 0)
  27.             For j = 0 To n - 1
  28.                 If brr(i, j + 1) = "" Then Exit For
  29.                 If j Mod 3 = 0 Then K = K + 1
  30.                 brr2(K, j Mod 3) = brr(i, j + 1)
  31.             Next
  32.         Next
  33.         Target.Resize(K, 4) = brr2
  34.     End If
  35. End Sub
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
发表于 2012-3-21 17:03 | 显示全部楼层
[广告] ★ 对Excel用户最友好的数据分析编程语言，再不发愁Excel计算困难和容量限制 ★
转置-8 要求： 同样按照项目进行最大3列的折叠式展开，但是第1列各行都i需要出现项目名。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Target.Column = 1 And Target.Row > 14 And Target = "" Then
  4.         arr = Sheets(1).[a1].CurrentRegion
  5.         m = UBound(arr)
  6.         ReDim brr(1 To m, m)
  7.         For i = 1 To m
  8.             For j = 1 To m
  9.                 If arr(i, 1) = brr(j, 0) Or brr(j, 0) = "" Then
  10.                     If j > l Then l = j
  11.                     For K = 1 To m
  12.                         If brr(j, K) = "" Then
  13.                             If K > n Then n = K
  14.                             brr(j, 0) = arr(i, 1)
  15.                             brr(j, K) = arr(i, 2)
  16.                             GoTo Nxt
  17.                         End If
  18.                     Next
  19.                 End If
  20.             Next
  21. Nxt:
  22.         Next
  23.         ReDim brr2(1 To m, -1 To 2)
  24.         K = 0
  25.         For i = 1 To l
  26.             For j = 0 To n - 1
  27.                 If brr(i, j + 1) = "" Then Exit For
  28.                 If j Mod 3 = 0 Then K = K + 1: brr2(K, -1) = brr(i, 0)
  29.                 brr2(K, j Mod 3) = brr(i, j + 1)
  30.             Next
  31.         Next
  32.         Target.Resize(K, 4) = brr2
  33.     End If
  34. End Sub
复制代码
回复

举报

下一页 »
1 ...789101112131415... 56下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-25 10:42 , Processed in 0.036633 second(s), 6 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！     本站特聘法律顾问：李志群律师

快速回复 返回顶部 返回列表