ความคิดเห็นที่ 1
Sub IdentifyGroup()
Dim MemberGroupColor(1 To 2000) As Long
Dim MemberGroupColorF(1 To 2000) As Long
Dim MemberGroupNumber(1 To 2000) As Long
Dim MemberGroupCode(1 To 2000, 1 To 200) As String
Dim MemberGroupName(1 To 2000, 1 To 200) As String
Sheets("Main").Select
k = 2
Do
k = k + 1
Loop Until Cells(k + 1, 1) = ""
NStu = k - 2
For i = 1 To NStu
If i = 1 Then
NumberGroup = 1
MemberGroupColor(1) = Cells(i + 2, 1).Interior.ColorIndex
MemberGroupColorF(1) = Cells(i + 2, 1).Font.ColorIndex
MemberGroupNumber(1) = 1
MemberGroupCode(1, 1) = Cells(i + 2, 1)
MemberGroupName(1, 1) = Cells(i + 2, 2)
Else
Temp = Cells(i + 2, 1).Interior.ColorIndex
Temp1 = Cells(i + 2, 1).Font.ColorIndex
For k = 1 To NumberGroup
If Temp = MemberGroupColor(k) And Temp1 = MemberGroupColorF(k) Then
MemberGroupNumber(k) = MemberGroupNumber(k) + 1
MemberGroupCode(k, MemberGroupNumber(k)) = Cells(i + 2, 1)
MemberGroupName(k, MemberGroupNumber(k)) = Cells(i + 2, 2)
GoTo 1:
Else
If k = NumberGroup Then
NumberGroup = NumberGroup + 1
MemberGroupColor(NumberGroup) = Temp
MemberGroupColorF(NumberGroup) = Temp1
MemberGroupNumber(NumberGroup) = 1
MemberGroupCode(NumberGroup, MemberGroupNumber(NumberGroup)) = Cells(i + 2, 1)
MemberGroupName(NumberGroup, MemberGroupNumber(NumberGroup)) = Cells(i + 2, 2)
End If
End If
Next k
1:
End If
Next i
Sheets("Group").Select
Cells.Clear
NPos = 0
For k = 1 To NumberGroup
Cells(NPos + 1, 1) = "Group #" & k
Cells(NPos + 1, 1).Font.ColorIndex = MemberGroupColorF(k)
Cells(NPos + 1, 1).Interior.ColorIndex = MemberGroupColor(k)
Cells(NPos + 1, 1).Font.Bold = True
For j = 1 To MemberGroupNumber(k)
Cells(NPos + j + 1, 1) = MemberGroupCode(k, j)
Cells(NPos + j + 1, 1).Font.ColorIndex = MemberGroupColorF(k)
Cells(NPos + j + 1, 1).Interior.ColorIndex = MemberGroupColor(k)
Cells(NPos + j + 1, 1).Font.Bold = True
Cells(NPos + j + 1, 2) = MemberGroupName(k, j)
Cells(NPos + j + 1, 2).Font.ColorIndex = MemberGroupColorF(k)
Cells(NPos + j + 1, 2).Interior.ColorIndex = MemberGroupColor(k)
Cells(NPos + j + 1, 2).Font.Bold = True
Next j
NPos = NPos + MemberGroupNumber(k) + 2
Next k
Cells.EntireColumn.AutoFit
End Sub
จากคุณ :
Practical x 2  
- [
27 ต.ค. 50 01:29:05
]
|
|
|
... เข้ามาดู
