ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求帮忙编辑一段vba代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-9-19 21:06 | 显示全部楼层 |阅读模式
求助要求:
总表数据能自动按分表名字把成绩数据粘贴至分表中,如1号李明的成绩数据能一键归纳到分表“1号 李明”的对应位置
附:如果能做到按总表名字一键命名分表标签名字就更好了
希望各位大神鼎力相助,本人每次复制粘贴成绩都要头秃了,也请给一个小小的偷师机会,谢谢

求助工作表模板.rar

11.38 KB, 下载次数: 30

模板

TA的精华主题

TA的得分主题

发表于 2020-9-19 21:54 来自手机 | 显示全部楼层
下面是一个通用拆表的代码,你可以试试。(注意不要先建好表名,只保留总表.)
Sub 一表拆多表()
    Dim d As Object, sht As Worksheet
    Dim aData, aResult, aTemp, aKeys, i&, j&, k&, x&
    Dim rngData As Range, rngGist As Range
    Dim lngTitleCount&, lngGistCol&, lngColCount&
    Dim rngFormat As Range
    Dim strKey As String
    Set d = CreateObject("scripting.dictionary")
    Set rngGist = Application.InputBox("请框选拆分依据列!只能选择单列单元格区域!", Title:="提示", Type:=8)
    lngGistCol = rngGist.Column
    lngTitleCount = Val(Application.InputBox("请输入总表标题行的行数?"))
    If lngTitleCount < 0 Then MsgBox "标题行数不能为负数,程序退出。": Exit Sub
    Set rngData = ActiveSheet.UsedRange
    Set rngFormat = ActiveSheet.Cells
    aData = rngData.Value
    lngGistCol = lngGistCol - rngData.Column + 1
    lngColCount = UBound(aData, 2)
    For i = lngTitleCount + 1 To UBound(aData)
        If aData(i, lngGistCol) = "" Then aData(i, lngGistCol) = "单元格空白"
        strKey = aData(i, lngGistCol)
        If Not d.exists(strKey) Then
            d(strKey) = i
        Else
            d(strKey) = d(strKey) & "," & i
        End If
    Next
    Application.DisplayAlerts = False
    For Each sht In ActiveWorkbook.Worksheets
        If d.exists(sht.Name) Then sht.Delete
    Next
    Application.DisplayAlerts = True
    aKeys = d.keys
    Application.ScreenUpdating = False
    For i = 0 To UBound(aKeys)
        If aKeys(i) <> "" Then
            aTemp = Split(d(aKeys(i)), ",")
            ReDim aResult(1 To UBound(aTemp) + 1, 1 To lngColCount)
            k = 0
            For x = 0 To UBound(aTemp)
                k = k + 1
                For j = 1 To lngColCount
                    aResult(k, j) = aData(aTemp(x), j)
                Next
            Next
            With Worksheets.Add(, Sheets(Sheets.Count))
                .Name = aKeys(i)
                .[a1].Resize(UBound(aData), lngColCount).NumberFormat = "@"
                If lngTitleCount > 0 Then .[a1].Resize(lngTitleCount, lngColCount) = aData
                .[a1].Offset(lngTitleCount, 0).Resize(k, lngColCount) = aResult
                rngFormat.Copy
                .[a1].PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .[a1].Offset(lngTitleCount + k, 0).Resize(UBound(aData) - k - lngTitleCount, 1).EntireRow.Delete
                .[a1].Select
            End With
        End If
    Next
    rngData.Parent.Activate
    Application.ScreenUpdating = True
    Set d = Nothing
    Set rngData = Nothing
    Set rngGist = Nothing
    Set rngFormat = Nothing
    Erase aData: Erase aResult
    MsgBox "数据拆分完成!"
End Sub

TA的精华主题

TA的得分主题

发表于 2020-9-20 07:07 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
20200920_070604.gif
直接生成分表也可以,就是比较麻烦,没有直接匹配查找方便一点。。。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-9-20 08:57 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-9-20 09:04 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
总表是第一次的数据,分表有第一次,第二次,还有第三次,第四次。。。吗?每次数据是怎么处理的?楼主的要求有点看不懂。。。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-9-20 11:05 来自手机 | 显示全部楼层
笨鸟飞不高 发表于 2020-9-20 09:04
总表是第一次的数据,分表有第一次,第二次,还有第三次,第四次。。。吗?每次数据是怎么处理的?楼主的要 ...

其实就是上面给我们总表,但年级要求我们对每个学生做一个档案跟踪,一个学生一份表,比如模板中的1号、2号、3号学生,然后每次考试之后,就把他对应的各科成绩导到学生自己的表里,一个班48个人的话,就要复制48次以上,所以我觉得麻烦,还容易眼花看错 所以如果我能只换总表数据,就那几列,然后每次按个键,他就自动归类到学生个人分表中最好了。我说明白了吗

TA的精华主题

TA的得分主题

发表于 2020-9-20 11:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
拆分问题,可以去我的主题里面下载灵活拆分工具,但是,就如5楼所说的情况,不知楼主是什么意思或者需要如何处理?
Excel 灵活拆分工具之二-ExcelVBA程序开发-ExcelHome技术论坛 -  http://club.excelhome.net/thread-1533849-1-1.html

TA的精华主题

TA的得分主题

发表于 2020-9-20 13:27 | 显示全部楼层
每增加一个学生都会自动增加表格并命名,根据最后一次测试,判断汇总表的测试是否测试过,没有的话就分配总表数据到分表。

说明:根据最后一次统计数据判断现有数据

说明:根据最后一次统计数据判断现有数据

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-9-20 13:31 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
已解决,谢谢各位

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-9-20 13:34 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 Vincycc 于 2020-9-20 13:36 编辑
haohu0406 发表于 2020-9-20 13:27
每增加一个学生都会自动增加表格并命名,根据最后一次测试,判断汇总表的测试是否测试过,没有的话就分配总 ...

您能分享一下代码吗?万分感谢
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 05:34 , Processed in 0.048179 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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