excl數(shù)據(jù)分類代碼求教！

yanlj518

把sheet1的數(shù)據(jù)按班級(jí)復(fù)到各自工作表中，代碼死循環(huán)了，求教高手！

roych

樓主的思路估計(jì)是想一行行復(fù)制粘貼。但這里有一個(gè)問(wèn)題需要解決：粘貼完每一行，都需要記錄被粘貼的位置，否則下次粘貼就會(huì)出現(xiàn)空行。

這樣說(shuō)可能有些難以理解。打個(gè)比方：
第一次，復(fù)制數(shù)據(jù)源的第2行，粘貼到工作表“1”的第2行，這時(shí)候記下這個(gè)位置A。
第二次，復(fù)制第3行，粘貼到工作表“2”的第2行，再記下這個(gè)位置B。
第三次，復(fù)制第4行，粘貼到工作表“1”的位置A的下一行，并更新位置A。
…………
這只是2個(gè)工作表，就要記下2個(gè)位置，不僅需要避免混淆，還需要更新。
因此如果一行行復(fù)制，需要定義一個(gè)字典或者集合，以工作表名稱為鍵名（key），以位置作為鍵值（value），才能完成這個(gè)任務(wù)。
個(gè)人覺(jué)得比較復(fù)雜，因此采用一種更加方便的做法，就是使用自動(dòng)篩選，根據(jù)篩選值的個(gè)數(shù)復(fù)制粘貼，這樣的話，相對(duì)來(lái)說(shuō)，效率也會(huì)高一些，逐行復(fù)制粘貼20次，但自動(dòng)篩選只有2次。而且不容易混淆。畢竟一個(gè)班只會(huì)復(fù)制粘貼一次。
代碼如下：

1. Sub feilei()
   
2. 
   
3. 
   
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.     '獲取行數(shù)
   
10.     lngRows = Sheet1.UsedRange.Rows.Count
    
11.    
    
12.    
    
13.     '篩選不重復(fù)班級(jí),丟進(jìn)字典里，用于后續(xù)篩選
    
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.     '篩選數(shù)據(jù)
    
27.         Sheet1.Range("A1:G" & lngRows).AutoFilter 3, key
    
28.     '復(fù)制篩選結(jié)果
    
29.         Sheet1.Range("A2:G" & lngRows).Select
    
30.         Selection.Copy
    
31.         For i = 1 To Sheets.Count
    
32.         '如果工作表名稱和篩選條件相同（由于name是文本類型，因此需要使用cstr轉(zhuǎn)為文本，否則將無(wú)法粘貼或者報(bào)錯(cuò)）
    
33.             If Sheets(i).Name = CStr(key) Then
    
34.                 Sheets(i).Activate
    
35.                 '激活A(yù)2單元格
    
36.                 Sheets(i).Range("A2").Activate
    
37.                 '粘貼數(shù)據(jù)后跳出循環(huán)，可以減少循環(huán)次數(shù)
    
38.                 ActiveSheet.Paste
    
39.                 Exit For
    
40.             End If
    
41.         Next
    
42.     Next
    
43.     '取消自動(dòng)篩選
    
44.     Sheet1.Range("A1:G" & lngRows).AutoFilter
    
45.    
    
46.    
    
47. End Sub
    
48. 
    

復(fù)制代碼