|
楼主的思路估计是想一行行复制粘贴。但这里有一个问题需要解决:粘贴完每一行,都需要记录被粘贴的位置,否则下次粘贴就会出现空行。
这样说可能有些难以理解。打个比方:
第一次,复制数据源的第2行,粘贴到工作表“1”的第2行,这时候记下这个位置A。
第二次,复制第3行,粘贴到工作表“2”的第2行,再记下这个位置B。
第三次,复制第4行,粘贴到工作表“1”的位置A的下一行,并更新位置A。
…………
这只是2个工作表,就要记下2个位置,不仅需要避免混淆,还需要更新。
因此如果一行行复制,需要定义一个字典或者集合,以工作表名称为键名(key),以位置作为键值(value),才能完成这个任务。
个人觉得比较复杂,因此采用一种更加方便的做法,就是使用自动筛选,根据筛选值的个数复制粘贴,这样的话,相对来说,效率也会高一些,逐行复制粘贴20次,但自动筛选只有2次。而且不容易混淆。毕竟一个班只会复制粘贴一次。
代码如下:
- Sub feilei()
- Dim lngRows As Long
- Dim i As Long
- Dim lngClass As Long
- Dim dict As New Dictionary
- Dim key As Variant
- '获取行数
- lngRows = Sheet1.UsedRange.Rows.Count
-
-
- '筛选不重复班级,丢进字典里,用于后续筛选
- For i = 2 To lngRows
- lngClass = Sheet1.Range("C" & i)
- If Not dict.Exists(lngClass) Then
- dict(lngClass) = ""
- End If
- Next
-
-
-
- For Each key In dict.Keys
- '激活工作表
- Sheet1.Activate
- '筛选数据
- Sheet1.Range("A1:G" & lngRows).AutoFilter 3, key
- '复制筛选结果
- Sheet1.Range("A2:G" & lngRows).Select
- Selection.Copy
- For i = 1 To Sheets.Count
- '如果工作表名称和筛选条件相同(由于name是文本类型,因此需要使用cstr转为文本,否则将无法粘贴或者报错)
- If Sheets(i).Name = CStr(key) Then
- Sheets(i).Activate
- '激活A2单元格
- Sheets(i).Range("A2").Activate
- '粘贴数据后跳出循环,可以减少循环次数
- ActiveSheet.Paste
- Exit For
- End If
- Next
- Next
- '取消自动筛选
- Sheet1.Range("A1:G" & lngRows).AutoFilter
-
-
- End Sub
复制代码
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|