请大神帮忙编写VBA，减轻工作，谢谢！！

烟火孤星泪 · 发表于 2018-8-31 09:59

本帖最后由烟火孤星泪于 2018-8-31 10:30 编辑

新学期工作量多，请高手帮忙
要求如下：
根据原始数据表的内容，批量生成”生成表“的形式，请大神帮忙VBA批量怎么操作，数据大约有2000条左右吧，谢谢

相同名称取对应数据批量（合并）.rar (34.22 KB, 下载次数: 8)

VBA密码已删除，附件也重新上传，麻烦大神帮忙看看，编写一下，谢谢！！

烟火孤星泪 · 发表于 2018-8-31 10:05

求大家帮忙，工作量太大了，文件中已经编写了一部分vba，再增加一列，不知如何添加

烟火孤星泪 · 发表于 2018-8-31 10:23

有人帮一下忙吗？谢谢

zhjlgaojuan · 发表于 2018-8-31 10:26

你附件都上密码锁了,人家想帮都没法帮啊

烟火孤星泪 · 发表于 2018-8-31 10:30

zhjlgaojuan 发表于 2018-8-31 10:26
你附件都上密码锁了,人家想帮都没法帮啊

VBA密码已删除，附件也重新上传，麻烦大神帮忙看看，谢谢！！

一指禅62 · 发表于 2018-8-31 10:41

Sub 按班级合并()
Dim arr, i&, d As Object, key$, Rng As Range
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A1").CurrentRegion
For i = 2 To UBound(arr)
key = arr(i, 1) & "|" & arr(i, 2)
If Not d.Exists(key) Then
d(key) = arr(i, 3)
Else
d.Item(key) = d.Item(key) & "、" & arr(i, 3)
End If
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet2.Select
Range("A2:C1000").UnMerge
Range("A2:C1000").ClearContents
Range("A2").Resize(d.Count, 3) = WorksheetFunction.Transpose(Array(d.keys, d.keys, d.items))
Range("A:A").Replace "|*", ""
Range("B:B").Replace "*|", ""
For Each Rng In Range("A2:A" & d.Count)
If Rng.Value = Rng.Offset(1, 0) Then
Rng.Resize(2, 1).Merge
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

复制代码

一指禅62 · 发表于 2018-8-31 10:43

数据合并.rar (33.32 KB, 下载次数: 10)
VBE 加个密码什么意思？

烟火孤星泪 · 发表于 2018-8-31 10:50

一指禅62 发表于 2018-8-31 10:43
VBE 加个密码什么意思？

之前加个密码，避免代码变动，导致错误，非常感谢！

烟火孤星泪 · 发表于 2018-8-31 10:52

一指禅62 发表于 2018-8-31 10:43
VBE 加个密码什么意思？

你好，出现了一个问题，生成了表格，如果是多个班级，都是相同专业的，能否只显示一个计算机专业，谢谢

zhjlgaojuan · 发表于 2018-8-31 11:12

本帖最后由 zhjlgaojuan 于 2018-8-31 13:33 编辑

.....................

		自动登录	找回密码
密码			免费注册

[求助] 请大神帮忙编写VBA，减轻工作，谢谢！！