Kính gửi: mọi người và anh/chị VetMini
Do trong phạm vi trình độ và nhận thức giới hạn hiện tại, theo hướng dẫn của anh/ chị VetMini tôi thực hiện theo cách sau:
1. Hàm lấy nội dung của thủ tục/ hàm trong module
[GPECODE=vb]
Function CopyCodeProc(NameModule As String, NameProc As String) As String
On Error GoTo EndSub:
Dim StartLine As Long, CountLine As Long
Dim ID_Module As LongDim VBACode As CodeModule
Set VBACode = ThisWorkbook.VBProject.VBComponents(NameModule).CodeModule
If NameProc <> vbNullString Then
With VBACode
StartLine = .ProcBodyLine(NameProc, vbext_pk_Proc)
CountLine = .ProcCountLines(NameProc, vbext_pk_Proc)
CopyCodeProc = .Lines(StartLine, CountLine)
End With
Else
With VBACode
StartLine = 1
CountLine = .CountOfLines
CopyCodeProc = .Lines(StartLine, CountLine)
End With
End If
EndSub:
If Err <> 0 Then MsgBox Err.Description, vbCritical, Err.Number
Set VBCode = Nothing
End Function
[/GPECODE]
2. Tôi liệt kê các từ khóa (key word, function, Command, Method...) vào Sheet1[A1:B137] (chưa thống kê được tất cả).
3. Sử dụng hàm sau để so sánh và tìm ra từ khóa, giá trị trả về là chuỗi.
[GPECODE=vb]
Function FilterCodeWord(NameModule As String, NameProc As String)
Dim MyDic As Object, MyResult As Object, TmpArr, CodeArr, MyString As String, ResultArr(), n As Integer, iWord
On Error Resume Next
Set MyDic = CreateObject("Scripting.Dictionary")
Set MyResult = CreateObject("Scripting.Dictionary")
'Nap Dic
With MyDic
TmpArr = Sheets("Sheet1").Range("A1:B137").Value2
For iRow = 1 To UBound(TmpArr, 1)
.CompareMode = vbTextCompare
.Add TmpArr(iRow, 1), TmpArr(iRow, 2)
Next
MyString = CopyCodeProc(NameModule, NameProc)
MyString = Replace(MyString, Chr(13), " ")
CodeArr = Split(MyString, " ")
For iWord = 0 To UBound(CodeArr)
If .Exists(CodeArr(iWord)) Then
MyResult.Add CodeArr(iWord), .Item(CodeArr(iWord))
End If
Next
End With
FilterCodeWord = Join(MyResult.Keys, Chr(13))
Set MyResult = Nothing
Set MyDic = Nothing
End Function
[/GPECODE]
4. Thủ tục chạy thử
[GPECODE=vb]
Sub Test()
Dim CodeString As String
MsgBox "Code la:" & Chr(13) & CopyCodeProc("MyCode", "Demo")
MsgBox "Tu khoa la: " & Chr(13) & FilterCodeWord("MyCode", "Demo")
End Sub
[/GPECODE]
Hạn chế:
- Tôi sử dụng dấu cách " " để phân biệt từ từ trong code nên sẽ không phân biệt được một số từ khóa, ví dụ; End với End Sub, End If..., for với for each...
- Kết quả trả về chưa liệt kê hết, ví dụ phần test trên phải cho ra 5 từ khóa (Sub, as, String, Dim, Msgbox, End Sub) nhưng kết quả trả về mới có 3 từ khóa (Sub, As, String). Hiện tôi chưa biết sửa ra sao.
Vậy rất mong nhận được sự giúp đỡ của các Anh, Chị!
