Lọc Dữ liệu thuật ngữ
Em đang muốn làm từ điển tra cứu thuật ngữ, bác nào giúp em chuyển file dữ liệu này thành một cột từ, một cột nghĩa sang excel với
Copy dữ liệu của bạn vào một file Excel (Chỉ copy phần thuật ngữ thôi) và chạy Macro này:
Sub Term()
Application.ScreenUpdating = 0
Dim Term As String, Interpretation As String
For Each cll In Range(, .End(xlUp).Offset(1))
If (cll.Font.Bold = True And cll.Font.Size < 30 And Not IsNumeric(cll.Value)) Or cll.Row = .End(xlUp).Row + 1 Then
With .End(xlUp)
.Offset(1).Value = Term
.Offset(1, 1).Value = Interpretation
End With
Term = cll.Value
Interpretation = ""
ElseIf cll.Value <> "" And (cll.Font.Size < 30 Or IsNull(cll.Font.Size)) And Not IsNumeric(cll.Value) Then
Interpretation = Interpretation & IIf(Interpretation = "", "", ChrW(10)) & cll.Value
End If
Next
Application.ScreenUpdating = 1
End Sub
Đây là file dữ liệu tôi copy từ word sang và đã có sẵn Macro. Bạn có thể tải về chạy thử để nghiên cứu.
Không được hoàn thiện như bản kết quả của bạn, chắc phải tự mày mò thôi, cảm ơn bạn Thắng nhiều nhiều, hi hi
Đương nhiên sau khi chạy macro xong bạn phải xóa dữ liệu cũ đi và format lại theo ý bạn. Cái này làm bằng tay đâu mất bao nhiêu thời gian. Tôi không đưa vào code vì không muốn code thêm phức tạp .Vì bạn nói muốn xem để nghiên cứu nên càng gọn càng tốt, thực hiện công việc chính là đủ.
www.giaiphapexcel.com/diendan/threads/l%E1%BB%8Dc-d%E1%BB%AF-li%E1%BB%87u-thu%E1%BA%ADt-ng%E1%BB%AF.32446/#post-216558
Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM
Khóa học “Thiết kế Tổng phần thưởng (Total Reward) chuẩn khung SHRM” giúp bạn nắm vững toàn bộ hệ thống đãi ngộ theo chuẩn...
Xem khóa học
Bạn tham khảo và lập cho mình 1 từ điển xem sao.
Tạo 1 Form có các đối tượng sau:
1/TextBox1: Để hiển thị diễn giải nội dung của từ được chọn trên Listbox1.
2/TextBox2: Để nhập từ cần tra.
3/ListBox1: Để liệt kê các từ gần đúng với từ nhập vào TextBox2. Nếu TextBox2="" thì hiển thị tất cả.
Đây là code của Form có tên là UserForm1:
Private Sub ListBox1_Click()
Me.TextBox1 = Application.WorksheetFunction.VLookup(ListBox1, Sheet2.Range("A1:B1000"), 2, 0)
End Sub
'—————————————————————-
Private Sub TextBox2_Change()
NapDS
End Sub
'—————————————————————–
Private Sub UserForm_Initialize()
Application.Visible = False
NapDS
End Sub
'—————————————————————–
Sub NapDS()
Dim tam
On Error Resume Next
Tc = Me.TextBox2
If Trim(Tc) = "" Then Tc = "*"
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
TextBox1 = ""
With Sheet2
.Range("A1:A1000").AutoFilter Field:=1, Criteria1:="=" & Tc & "*"
tam = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows. _
Count – 1).SpecialCells(xlCellTypeVisible)
Me.ListBox1.List() = tam
If Me.ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
.Range("A1:A1000").AutoFilter
End With
Me.TextBox1 = Application.WorksheetFunction.VLookup(ListBox1, Sheet2.Range("A1:B1000"), 2, 0)
End Sub
'————————————————————-
Private Sub UserForm_Terminate()
Application.Visible = True
End SubVà đây là code mở Form:
Sub AutoShape1_Click()
UserForm1.Show
End SubP/s: Đúng là Code của mình không có Pass mà Pass cua AddIn RepliGo.xla của bạn chứ. Bạn nhấn Cancel rồi chọn VBA Project(Tudien.xls) của mình ở bên dưới ấy.