register313

¦^´_ 3# bhsm

1. Sub YY()
   
2. R = 1: C = 0
   
3. Sheets("¬Û¦P").Columns("A:B") = ""
   
4. For Each Sh In Sheets
   
5.   If Sh.Name <> "¬Û¦P" Then
   
6.      For Each Rng In Range(Sh.[A6], Sh.[A6].End(xlDown))
   
7.        With Sheets("¬Û¦P")
   
8.          If Application.CountIf(.Columns("A"), Rng.Value) = 0 Then
   
9.             .Cells(R, 1) = Rng.Value
   
10.             .Cells(R, 2) = C + 1
    
11.             R = R + 1
    
12.          Else
    
13.             x = Application.Match(Rng.Value, .Columns("A"), 0)
    
14.             .Cells(x, 2) = .Cells(x, 2) + 1
    
15.          End If
    
16.        End With
    
17.      Next
    
18.   End If
    
19. Next
    
20. End Sub

½Æ»s¥N½X