ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 734|回复: 7

[求助] 如何根据原始表姓名和学科两列以学科为关键字分学科排列且每列为30换列

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-9-21 16:51 | 显示全部楼层 |阅读模式
原始表:姓名,学科,以学科为关键字
目标表:分学科生成列出姓名,包括学科、空格和姓名,30个再换列排列,且空1列 如何根据原始表姓名和学科两列以学科为关键字分学科排列且每列为30换列.rar (5.18 KB, 下载次数: 8)

TA的精华主题

TA的得分主题

发表于 2017-9-21 17:39 | 显示全部楼层
语文后面有空格,其它科后面没有空格?

TA的精华主题

TA的得分主题

发表于 2017-9-21 17:47 | 显示全部楼层
老司机了,字典加数组就完成了。自己写代码就好。
if not dic.exists(学科)then
dic(学科)=教师
else
dic(学科)=dic(学科)& "|" & 教师
end if
循环字典,拆分items

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-9-21 18:58 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Sub Test()
  2.     Dim d As Object, arA, arB, k, i&, x%, y%
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     arA = Sheets("原始表").UsedRange
  5.     For i = 2 To UBound(arA)
  6.         If Not d.Exists(arA(i, 3)) Then
  7.             d(arA(i, 3)) = Array(2, arA(i, 3), arA(i, 2))
  8.         Else
  9.             k = d(arA(i, 3))
  10.             k(0) = k(0) + 1
  11.             ReDim Preserve k(k(0))
  12.             k(k(0)) = arA(i, 2)
  13.             d(arA(i, 3)) = k
  14.         End If
  15.     Next
  16.     i = Application.RoundUp((UBound(arA) + d.Count * 2 - 1) / 30 * 2, 0)
  17.     [a3].Resize(30, i).ClearContents
  18.     ReDim arB(1 To 30, 1 To i)
  19.     y = 1
  20.     For Each k In d.Items
  21.         x = x + 1
  22.         For i = 1 To k(0)
  23.             arB(x, y) = k(i)
  24.             If x = 30 Then y = y + 2
  25.             x = IIf(x = 30, 1, x + 1)
  26.         Next
  27.     Next
  28.     [a3].Resize(30, UBound(arB, 2)) = arB
  29. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-9-21 19:00 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-9-21 20:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

i = Application.RoundUp((UBound(arA) + d.Count * 2 - 1) / 30 * 2, 0)
请问高手,这句是怎么想到的呢,可以看出是计算列数,但是面对这样的问题有什么具体思路吗?

TA的精华主题

TA的得分主题

发表于 2017-9-21 21:09 | 显示全部楼层
xing836 发表于 2017-9-21 20:57
i = Application.RoundUp((UBound(arA) + d.Count * 2 - 1) / 30 * 2, 0)
请问高手,这句是怎么想到的 ...

首先确定源数据的总行数加上关键词的个数及空格数,楼主要求存放时每列30个,列之间间隔1空列,那么总数除30乘2,再用RoundUp函数向上舍入,就得到要存放的列数

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-9-22 10:36 | 显示全部楼层
  1. Sub hh()
  2. arr = Sheets("原始表").[a1].CurrentRegion
  3.         Set d = CreateObject("scripting.dictionary")
  4.         ReDim br(1 To 30, 1 To Int(UBound(arr) / 30 + 1) * 2)
  5.         For i = 2 To UBound(arr)
  6.             If Not d.Exists(arr(i, 3)) Then
  7.                 Set d(arr(i, 3)) = CreateObject("scripting.dictionary")
  8.             End If
  9.              d(arr(i, 3))(arr(i, 2)) = ""
  10.         Next
  11.         k = d.keys
  12.             For q = 0 To UBound(k)
  13.                 w = d(k(q)).keys
  14.                 For j = 0 To UBound(w)
  15.                 n = n + 1
  16.                 If j = 0 Then
  17.                 br((n - 1) Mod 30 + 1, Int((n - 1) / 30) * 2 + 1) = k(q)
  18.                 n = n + 2
  19.                 br((n - 1) Mod 30 + 1, Int((n - 1) / 30) * 2 + 1) = w(j)
  20.                 Else
  21.                 br((n - 1) Mod 30 + 1, Int((n - 1) / 30) * 2 + 1) = w(j)
  22.                 End If
  23.                 Next
  24.             Next
  25.             Sheets("目标表").[a3].Resize(30, Int(UBound(arr) / 30 + 1) * 2) = ""
  26.             Sheets("目标表").[a3].Resize(30, Int(UBound(arr) / 30 + 1) * 2) = br
  27. End Sub
复制代码

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 09:44 , Processed in 0.045183 second(s), 18 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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