[µo°Ý] ¤u§@ªí¸ê®Æ¤ÀÃþ¥t¦s¤u§@ªí

missbb

¦U¦ì, ¥»¤H¦³¤@WORKBOOK¤º¦³¸ê®Æ, »Ý­n¦bSORTING "¦a°Ï" ©M"²Õ§O" «á. «ö"¦a°Ï"¥t¦s·sWORKSHEET, ¨Ã¥H"¦a°Ï" §@¬°WORKSHEET¦WºÙ, ¦ý¤U¦CCODE¦³°ÝÃD, ¨D±Ð°ÝÃD©Ò¦b:D
¤u§@ªí¥t¦s (2).zip (22.65 KB)

¤U¸ü¦¸¼Æ: 2

2024-9-15 15:25

1. Sub TSsheet2()
   
2. 
   
3. Application.ScreenUpdating = 0
   
4. Dim rng As Range, d As Object, ws As Worksheet
   
5. Set ws = ActiveSheet
   
6. ws.AutoFilterMode = False
   
7. c = [a5].CurrentRegion.Columns.Count
   
8. Set d = CreateObject("scripting.dictionary")
   
9. Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))
   
10. a = rng.Columns(3)
    
11. For i = 2 To UBound(a)
    
12.     d(a(i, 1)) = ""
    
13. Next
    
14. k = d.keys
    
15. For i = 0 To UBound(k)
    
16.     ws.Copy after:=Sheets(Sheets.Count)
    
17.     ActiveSheet.AutoFilterMode = False
    
18.     [a5].CurrentRegion.Clear
    
19.     With ws
    
20.         rng.AutoFilter Field:=1, Criteria1:=k(i)
    
21.         .[a5].CurrentRegion.Copy [a5]
    
22.         
    
23.     End With
    
24.         
    
25.     ActiveSheet.Name = [A6].Value
    
26. Next
    
27. Application.ScreenUpdating = 1
    
28. 
    
29. With Sheets("data").Activate
    
30.     If ActiveSheet.FilterMode Then
    
31.       ActiveSheet.ShowAllData
    
32.     End If
    
33.    
    
34. End With
    
35. 
    
36. End Sub

½Æ»s¥N½X

catbears

¹Á¸ÕµÛ³v¦æ¤À¸Ñ
µo²{²Ä9¦æ·í¤¤
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))

Rows.Count > ³oÃ䪺¸ê®Æ·|¸õ¨ì¾ã±iEXCELªí¤¤ªº³Ì«á¤@¦æ¡A¦³ÂI¬Ý¤£¤ÓÀ´±z­n°µªº¨Æ±¡¡A¦]¦¹¶È¯à§iª¾±zªº³o³¡¤À¶}©l´N¤w¸g¸õ²æ¥Xµ{¦¡¾Þ§@ªº¤º®e¤F
¬O§_¯àµy§@»¡©ú±z¨C¨BÆJ·Q°µªº¨Æ±¡©O¡H

­ã´£³¡ªL

1.§ä³Ì«á«DªÅ¦æ, À³¨Ï¥Î xlup(3), ¦Ó«D (1)
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(3).Row, c))

2.¿z¿ïÄæ¦ì
a = rng.Columns(3) '¿z¿ï¤å¦r¦b²Ä3Äæ
rng.AutoFilter Field:=1, Criteria1:=k(i) '³o­Ó1À³§ï¦¨3

3.¤u§@ªí¦WºÙ
ActiveSheet.Name = [C6].Value