Office中国论坛/Access中国论坛

标题: excl数据分类代码求教！ [打印本页]
作者: yanlj518    时间: 2023-7-10 10:33
标题: excl数据分类代码求教！
把sheet1的数据按班级复到各自工作表中，代码死循环了，求教高手！
作者: roych    时间: 2023-7-13 21:58
楼主的思路估计是想一行行复制粘贴。但这里有一个问题需要解决：粘贴完每一行，都需要记录被粘贴的位置，否则下次粘贴就会出现空行。

这样说可能有些难以理解。打个比方：
第一次，复制数据源的第2行，粘贴到工作表“1”的第2行，这时候记下这个位置A。
第二次，复制第3行，粘贴到工作表“2”的第2行，再记下这个位置B。
第三次，复制第4行，粘贴到工作表“1”的位置A的下一行，并更新位置A。
…………
这只是2个工作表，就要记下2个位置，不仅需要避免混淆，还需要更新。
因此如果一行行复制，需要定义一个字典或者集合，以工作表名称为键名（key），以位置作为键值（value），才能完成这个任务。
个人觉得比较复杂，因此采用一种更加方便的做法，就是使用自动筛选，根据筛选值的个数复制粘贴，这样的话，相对来说，效率也会高一些，逐行复制粘贴20次，但自动筛选只有2次。而且不容易混淆。毕竟一个班只会复制粘贴一次。
代码如下：
  1. Sub feilei()


  4.     Dim lngRows As Long
  5.     Dim i As Long
  6.     Dim lngClass As Long
  7.     Dim dict As New Dictionary
  8.     Dim key As Variant
  9.     '获取行数
  10.     lngRows = Sheet1.UsedRange.Rows.Count
  11.    
  12.    
  13.     '筛选不重复班级,丢进字典里，用于后续筛选
  14.     For i = 2 To lngRows
  15.         lngClass = Sheet1.Range("C" & i)
  16.         If Not dict.Exists(lngClass) Then
  17.             dict(lngClass) = ""
  18.         End If
  19.     Next
  20.    
  21.    
  22.    
  23.     For Each key In dict.Keys
  24.     '激活工作表
  25.         Sheet1.Activate
  26.     '筛选数据
  27.         Sheet1.Range("A1:G" & lngRows).AutoFilter 3, key
  28.     '复制筛选结果
  29.         Sheet1.Range("A2:G" & lngRows).Select
  30.         Selection.Copy
  31.         For i = 1 To Sheets.Count
  32.         '如果工作表名称和筛选条件相同（由于name是文本类型，因此需要使用cstr转为文本，否则将无法粘贴或者报错）
  33.             If Sheets(i).Name = CStr(key) Then
  34.                 Sheets(i).Activate
  35.                 '激活A2单元格
  36.                 Sheets(i).Range("A2").Activate
  37.                 '粘贴数据后跳出循环，可以减少循环次数
  38.                 ActiveSheet.Paste
  39.                 Exit For
  40.             End If
  41.         Next
  42.     Next
  43.     '取消自动筛选
  44.     Sheet1.Range("A1:G" & lngRows).AutoFilter
  45.    
  46.    
  47. End Sub

复制代码
[attach]64606[/attach]




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3