ความคิดเห็นที่ 2
1. พิมพ์ชื่อและนามสกุลรวมกันไว้ที่คอลัมน์ B
2. กด ALT+F11
3. copy คำสั่ง Visual Basic นี้ลงไป
4. ตรวจสอบว่าโปรแกรมตั้งระบบความปลอดภัยระดับกลางเพื่อให้รันมาโครได้
5. รันโปรแกรมนี้
6. ตัวอย่างคือภาพด้านล่างครับ
Sub SearchForRepetition()
Dim ListName(1 To 1000) As String
Dim PosSpace(1 To 1000) As Integer
Dim SurName(1 To 1000) As String
Dim NewSurList(1 To 1000) As String
Dim CountRepNewSurList(1 To 1000) As Integer
Range(Cells(1, 4), Cells(65535, 256)).ClearContents
k = 0
Do
k = k + 1
Loop Until Cells(k + 1, 2) = ""
N = k
For i = 1 To N
ListName(i) = Cells(i, 2)
PosSpace(i) = InStr(1, ListName(i), " ")
SurName(i) = Mid(ListName(i), PosSpace(i) + 1)
If i = 1 Then
CountRow = 1
CountRepNewSurList(CountRow) = 1
Cells(CountRow, 4) = CountRepNewSurList(CountRow)
Cells(CountRow, 5) = SurName(1)
Cells(CountRow, 6) = ListName(1)
NewSurList(CountRow) = SurName(1)
Else
Temp = SurName(i)
For j = 1 To CountRow
If Temp = NewSurList(j) Then
CountRepNewSurList(j) = CountRepNewSurList(j) + 1
Cells(j, 5 + CountRepNewSurList(j)) = ListName(i)
Columns(5 + CountRepNewSurList(j)).AutoFit
Cells(j, 4) = CountRepNewSurList(j)
GoTo 1:
End If
Next j
CountRow = CountRow + 1
CountRepNewSurList(CountRow) = 1
Cells(CountRow, 4) = CountRepNewSurList(CountRow)
Cells(CountRow, 5) = SurName(i)
Cells(CountRow, 6) = ListName(i)
NewSurList(CountRow) = SurName(i)
End If
1:
Next i
For k = 4 To 6
Columns(k).AutoFit
Next k
End Sub
จากคุณ :
Practical x 2  
- [
18 ก.ค. 50 22:25:17
]
|
|
|
