ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 数据提取

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-5-5 21:56 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
问题.rar (36.57 KB, 下载次数: 30)

TA的精华主题

TA的得分主题

发表于 2024-5-5 22:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
PQ方案。。。。。。。。。。。。。。。。。。。。。。。。
捕获.PNG
捕获2.PNG

TA的精华主题

TA的得分主题

发表于 2024-5-6 07:42 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-5-6 08:39 | 显示全部楼层
全表自动生成。
附件供参考。。。




{B251272F-E8F5-49fc-9221-B14BCE4D8DA3}.png

问题2.7z

49.16 KB, 下载次数: 18

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-5-6 08:40 | 显示全部楼层
本帖最后由 ykcbf1100 于 2024-5-6 09:08 编辑

参与一下。。。

  1. Sub ykcbf()  '//2024.5.6
  2.     Dim arr, brr, d, s
  3.     Application.ScreenUpdating = False
  4.     Application.DisplayAlerts = False
  5.     Set d = CreateObject("scripting.dictionary")
  6.    
  7.     Set sh = ThisWorkbook.Sheets("班级任课教师及任课节数汇总表")
  8.     bt = [{"教师","节数"}]
  9.     m = 1
  10.     On Error Resume Next
  11.     With Sheets("总功课表(教师名字版)")
  12.         r = .Cells(Rows.Count, 1).End(3).Row
  13.         col = .UsedRange.Columns.Count
  14.         arr = .[a1].Resize(r, col)
  15.         ReDim brr(1 To UBound(arr), 1 To 300)
  16.         For i = 5 To UBound(arr)
  17.             If arr(i, 1) <> Empty Then
  18.                 s = arr(i, 1)
  19.                 If Not d.exists(s) Then
  20.                     m = m + 1
  21.                     d(s) = m
  22.                     brr(m, 1) = s
  23.                 End If
  24.                 r = d(arr(i, 1))
  25.                 n = 1: k = 0
  26.                 For j = 2 To UBound(arr, 2)
  27.                     If arr(i, j) <> Empty Then
  28.                         s = arr(i, 1) & "|" & Trim(arr(i, j))
  29.                         If Not d.exists(s) Then
  30.                             k = k + 1
  31.                             n = n + 2
  32.                             d(s) = n
  33.                             brr(1, n - 1) = bt(1) & k: brr(1, n) = bt(2)
  34.                             brr(m, n - 1) = Trim(arr(i, j))
  35.                         End If
  36.                         c = d(arr(i, 1) & "|" & Trim(arr(i, j)))
  37.                         brr(r, c) = brr(r, c) + 1
  38.                     End If
  39.                 Next
  40.             End If
  41.         Next
  42.     End With
  43.     With sh
  44.         .UsedRange.Clear
  45.         .[a1].Resize(m, n) = brr
  46.         .[a1].Resize(1, n).Interior.Color = 49407
  47.         .[a2].Resize(m - 1, 1).Interior.Color = 5296274
  48.         ActiveWindow.DisplayZeros = False
  49.         Set Rng = .[a1].Resize(m, n)
  50.         With Rng
  51.             .Borders.LineStyle = 1
  52.             .HorizontalAlignment = xlCenter
  53.             .VerticalAlignment = xlCenter
  54.             With .Font
  55.                 .Name = "微软雅黑"
  56.                 .Size = 11
  57.             End With
  58.         End With
  59.     End With
  60.     Set d = Nothing
  61.     Application.ScreenUpdating = True
  62. End Sub
复制代码


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-5-6 09:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
ykcbf1100 发表于 2024-5-6 08:39
全表自动生成。
附件供参考。。。

再次感谢老师的多次帮忙

TA的精华主题

TA的得分主题

发表于 2024-5-6 09:49 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-5-6 11:18 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. function test02(){
  2.         let sht=ThisWorkbook.Worksheets.Item('总功课表');
  3.         let sht2=ThisWorkbook.Worksheets.Item('任课节数汇总表');
  4.         let arr=sht.Range('A5').CurrentRegion.Value2.slice(2);
  5.         let all=[];
  6.         for(let r of arr)
  7.         {
  8.                 let tmp=[];
  9.                 tmp.push(r[0]);//班级推入数组
  10.                 let d=new Map();
  11.                 for(let c of r.slice(1))
  12.                 {
  13.                        
  14.                         if(d.has(c)){
  15.                                 let x=d.get(c);
  16.                                 x+=1;
  17.                                 d.set(c,x);
  18.                         }
  19.                         else
  20.                         {
  21.                                 d.set(c,1);
  22.                         }
  23.                 }
  24.                
  25.                 d.forEach((v,k)=>
  26.                         {
  27.                                 tmp.push(k);//教师
  28.                                 tmp.push(v);//节数
  29.                         })
  30.                
  31.                 all.push(tmp);//整行数据推入数组
  32.                
  33.         }
  34.        
  35.         let h=[];
  36.         for(let j=0;j<12;j++){
  37.                 h.push('教师'+(j+1).toString());
  38.                 h.push('节数');
  39.         }
  40.        
  41.         h.unshift('-');
  42.         all.unshift(h);//添加表头
  43.        
  44.         sht2.Cells(1,1).Resize(all.length,all[0].length).Value2=all;
  45.        
  46. }
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-5-6 14:46 | 显示全部楼层
本帖最后由 nihao123456789 于 2024-5-7 09:36 编辑

暴击了。删除

TA的精华主题

TA的得分主题

发表于 2024-5-6 15:43 | 显示全部楼层
  1. let
  2.     源 = Excel.Workbook(File.Contents("C:\下载文件夹\问题\问题.xlsx"), null, true),
  3.     #"总功课表(教师名字版)_Sheet" = 源{[Item="总功课表(教师名字版)",Kind="Sheet"]}[Data],
  4.     更改的类型 = Table.TransformColumnTypes(#"总功课表(教师名字版)_Sheet",{{"Column1", type text}, {"Column2", type text}, {"Column3", type text}, {"Column4", type text}, {"Column5", type text}, {"Column6", type text}, {"Column7", type text}, {"Column8", type text}, {"Column9", type text}, {"Column10", type text}, {"Column11", type text}, {"Column12", type text}, {"Column13", type text}, {"Column14", type text}, {"Column15", type text}, {"Column16", type text}, {"Column17", type text}, {"Column18", type text}, {"Column19", type text}, {"Column20", type text}, {"Column21", type text}, {"Column22", type text}, {"Column23", type text}, {"Column24", type text}, {"Column25", type text}, {"Column26", type text}, {"Column27", type text}, {"Column28", type text}, {"Column29", type text}, {"Column30", type text}, {"Column31", type text}, {"Column32", type text}, {"Column33", type text}, {"Column34", type text}, {"Column35", type text}, {"Column36", type text}, {"Column37", type text}, {"Column38", type text}, {"Column39", type text}, {"Column40", type text}, {"Column41", type text}, {"Column42", type any}}),
  5.     删除的顶端行 = Table.Skip(更改的类型,3),
  6.     删除的列 = Table.RemoveColumns(删除的顶端行,{"Column42"}),
  7.     逆透视的列 = Table.UnpivotOtherColumns(删除的列, {"Column1"}, "属性", "教师"),
  8.     删除的列1 = Table.RemoveColumns(逆透视的列,{"属性"}),
  9.     重命名的列 = Table.RenameColumns(删除的列1,{{"Column1", "班级"}}),
  10.     分组的行 = Table.Group(重命名的列, {"班级", "教师"}, {{"计数", each Table.RowCount(_), Int64.Type}}),
  11.     合并的列 = Table.CombineColumns(Table.TransformColumnTypes(分组的行, {{"计数", type text}}, "zh-CN"),{"教师", "计数"},Combiner.CombineTextByDelimiter(",", QuoteStyle.None),"已合并"),
  12.     分组的行1 = Table.Group(合并的列, {"班级"}, {"教师", each Text.Combine([已合并],",")}),
  13.     按分隔符拆分列 = Table.SplitColumn(分组的行1, "教师", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"教师.1", "教师.2", "教师.3", "教师.4", "教师.5", "教师.6", "教师.7", "教师.8", "教师.9", "教师.10", "教师.11", "教师.12", "教师.13", "教师.14", "教师.15", "教师.16", "教师.17", "教师.18", "教师.19", "教师.20", "教师.21", "教师.22", "教师.23", "教师.24"})
  14. in
  15.     按分隔符拆分列
复制代码
"C:\下载文件夹\问题\问题.xlsx"改成自己的地址

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

本版积分规则

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

GMT+8, 2024-5-19 04:23 , Processed in 0.044763 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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