[已解决]考勤分类，想用VBA实现，请高手指点

liyin1743 · 发表于 2012-9-26 13:05

本帖最后由 liyin1743 于 2012-9-27 13:22 编辑

小弟新手,请各位高手指点,附件传上了

不要管1班2班3班是按黄色区域的人名来分(如果在黄色区域后面增加几行中也有姓名),总体想把总表中的考勤用VBA来实现1班、2班、3班里,按人名来分类,

最好在VBA中注释下，不胜感激，本人想学习学习，在线等，请教VBA高手

新的问题出现了，在8楼，附件也在8楼，因改对工号的修改了吧，代码就不能用了，出现1004错误，请高手再次帮个忙

最佳答案

月排行榜 / 总排行榜

0Mouse

2012-9-26 15:13

效果图没错，1班里有个名字重复了
重复.jpg

单击“1班”、“2班”或“3班”，再执行代码试试看！

Sub xq()
Dim d As Object, rng As Range, arr, brr, i%, j%, k%
Set d = CreateObject("scripting.dictionary")
For Each rng In [B2:I7]
If rng <> "" Then
d(rng.Text) = ""
End If
Next
arr = Sheet1.[A1].CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
If d.exists(arr(i, 2)) Then
k = k + 1
For j = 1 To UBound(arr, 2)
brr(k, j) = arr(i, j)
Next
End If
Next
[A9].Resize(Rows.Count - 8, j - 1).ClearContents
[A9].Resize(k, j - 1) = brr
End Sub

复制代码

附件：

考勤分类xq.rar (33.01 KB, 下载次数: 18)

liyin1743 · 发表于 2012-9-26 14:26

在线求助，{:301:}谢谢

liyin1743 · 发表于 2012-9-26 14:54

{:021:}没人回复，高手们

0Mouse · 发表于 2012-9-26 15:13

这个最佳答案由 0Mouse 给出，感谢 0Mouse 的回答。

单击隐藏图章

效果图没错，1班里有个名字重复了
重复.jpg

单击“1班”、“2班”或“3班”，再执行代码试试看！

Sub xq()
Dim d As Object, rng As Range, arr, brr, i%, j%, k%
Set d = CreateObject("scripting.dictionary")
For Each rng In [B2:I7]
If rng <> "" Then
d(rng.Text) = ""
End If
Next
arr = Sheet1.[A1].CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
If d.exists(arr(i, 2)) Then
k = k + 1
For j = 1 To UBound(arr, 2)
brr(k, j) = arr(i, j)
Next
End If
Next
[A9].Resize(Rows.Count - 8, j - 1).ClearContents
[A9].Resize(k, j - 1) = brr
End Sub

复制代码

附件：

考勤分类xq.rar (33.01 KB, 下载次数: 18)

liyin1743 · 发表于 2012-9-26 16:16

本帖最后由 liyin1743 于 2012-9-26 16:18 编辑

0Mouse 发表于 2012-9-26 15:13
效果图没错，1班里有个名字重复了

单击“1班”、“2班”或“3班”，再执行代码试试看！附件：

谢谢高手，还有一个问题，如果按工号来分类，在代码中要怎么改~~~~谢谢~~~~

能不能注释下代码，我是新手，谢谢

0Mouse · 发表于 2012-9-26 16:25

liyin1743 发表于 2012-9-26 16:16
谢谢高手，还有一个问题，如果按工号来分类，在代码中要怎么改~~~~谢谢~~~~

能不能注释下代码，我是 ...

把现在的姓名改成工号
工号.jpg

然后把代码第12行

If d.exists(arr(i, 2)) Then

复制代码

改成

If d.exists(arr(i, 1)) Then

复制代码

应该就可以了。

liyin1743 · 发表于 2012-9-26 16:31

谢谢了，太感谢了，

liyin1743 · 发表于 2012-9-27 12:21

liyin1743 发表于 2012-9-26 16:31
谢谢了，太感谢了，

高手，后来在总表中，我改了下，要用工号来查找，怎么代码出错，请教你们~~~

mayingdi · 发表于 2012-9-29 07:30

我看了，除非英语六级，否则不要学VBA

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

[已解决]考勤分类，想用VBA实现，请高手指点

相关帖子