buisytrung
Thành viên mới

- Tham gia
- 23/10/08
- Bài viết
- 13
- Được thích
- 1
Xem file này xem được không nhé.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
Tôi sửa lại giúp bạn vậy.Cách tra thuật ngữ trên excel của bạn rất hay tuy nhiên để đọc được tài liệu tiếng anh thì phải mất khá nhiều thời gian để tra từ
Thực ra mình muốn tách cột từ và nghĩa để tạo dữ liệu cho từ điển BABYLON nổi tiếng, tra cứu thuận tiện hơn. Có cách nào để cột từ (không có từ nào trùng nhau), cột nghĩa (nhiều dòng ở một ô), từ và nghĩa trên một dòng.
Ví dụ
AAR_______________Abbreviation for:
__________________Against All Risks (insurance clause).
__________________ Association of American Railroads.
Acceptance________ abc
__________________ egf
Rất mong được sự giúp đỡ của bạn
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:Cảm ơn sự nhiệt tình giúp đỡ của mọi người, đặc biệt là bạn Hữu Thắng
Bạn Hữu Thắng có thể hướng dẫn mình cũng như các bạn đến sau quá trình làm được không. Đây là thông tin rất bổ ích phục vụ cho việc học tập và nghiên cứu ngoại ngữ, đặc biệt là tiếng anh chuyên ngành
Sub Term()
Application.ScreenUpdating = 0
Dim Term As String, Interpretation As String
For Each cll In Range([A1], [A65536].End(xlUp).Offset(1))
If (cll.Font.Bold = True And cll.Font.Size < 30 And Not IsNumeric(cll.Value)) Or cll.Row = [A65536].End(xlUp).Row + 1 Then
With [D65536].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
Đươ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à đủ.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
Bác paste code lên cho mọi người tham khảo được không, em tìm không biết nó ở đâuKỳ thật, mình thử lại vẫn mở bình thường mà. Bạn đừng nhấn nút mà nhấn Alt+F11 là OK
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 Sub
Sub AutoShape1_Click()
UserForm1.Show
End Sub