thientai12
Senior Member
Chào các bác ạ. Em hiện tại là bác sĩ.
Ở bv em có sử dụng phần mềm quản lý bv. Từ phần mềm thì có thể trích xuất ra được các kết quả xét nghiệm ra word, Excel. Theo yêu cầu của BHYT thì bs lại phải sao lại các kết quả này vào 1 chỗ khác.
Tuy nhiên trích xuất từ phần mềm thì nhanh, gọn, đầy đủ, không phải mất thời gian lật hồ sơ giấy, chờ giấy kết quả về (nhanh hơn khoảng 1 buổi) nhưng lại có quá nhiều từ thừa.
VD: RBC (số lượng hồng cầu): 4.5 T/l thì khi sao lại cho BHYT thì phải bỏ "số lượng hồng cầu'" đi. Và cứ phải loại bỏ như vậy cho hàng chục xét nghiệm mỗi ngày.
Vì vậy em lên đây làm phiền các bác có thể chỉ cách lập trình để loại bỏ các từ thừa ấy không ạ?
Kiểu mình copy vào 1 phần mềm xong ấn chạy là nó xóa hết các từ thừa rồi ấy ạ.
Chân thành cảm ơn các bác nhiều ạ
Đoạn mã em làm đây ạ
Update1: Đã chạy thực tế. Xuất hiện vấn đề là copy các từ cần thay thế thì lại bị lỗi font tiếng việt. Nên khi chạy thì không có thay đổi gì các bác ạ
Em có link file em thử làm ạ. Đoạn chữ màu đỏ là các từ cần bỏ. Đoạn văn bản phía dưới là đoạn cần chỉnh sửa ạ.
https://drive.google.com/file/d/1QjmyeJixRySm4OCDdb3t0DZyHxmQyX7D/view?usp=sharing
Ở bv em có sử dụng phần mềm quản lý bv. Từ phần mềm thì có thể trích xuất ra được các kết quả xét nghiệm ra word, Excel. Theo yêu cầu của BHYT thì bs lại phải sao lại các kết quả này vào 1 chỗ khác.
Tuy nhiên trích xuất từ phần mềm thì nhanh, gọn, đầy đủ, không phải mất thời gian lật hồ sơ giấy, chờ giấy kết quả về (nhanh hơn khoảng 1 buổi) nhưng lại có quá nhiều từ thừa.
VD: RBC (số lượng hồng cầu): 4.5 T/l thì khi sao lại cho BHYT thì phải bỏ "số lượng hồng cầu'" đi. Và cứ phải loại bỏ như vậy cho hàng chục xét nghiệm mỗi ngày.
Vì vậy em lên đây làm phiền các bác có thể chỉ cách lập trình để loại bỏ các từ thừa ấy không ạ?
Kiểu mình copy vào 1 phần mềm xong ấn chạy là nó xóa hết các từ thừa rồi ấy ạ.
Chân thành cảm ơn các bác nhiều ạ
Đoạn mã em làm đây ạ
Sub FindAndReplaceMultipleWordsInDocument()
Dim strFind As String, strReplace As String
Dim strFindArr, strReplaceArr
Dim i As Long
Application.ScreenUpdating = False
strFind = InputBox("Enter words to find separated by a comma ", "Enter words to find")
strReplace = InputBox("Enter the new replacement words separated by a comma.", "Enter Replacing Words")
strFindArr = Split(strFind, ",")
strReplaceArr = Split(strReplace, ",")
If UBound(strFindArr) <> UBound(strReplaceArr) Then
MsgBox "find and Replace words must be equal.", vbInformation, "Find Replace"
Exit Sub
End If
For i = 0 To UBound(strFindArr)
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFindArr(i)
.Replacement.Text = strReplaceArr(i)
.MatchWholeWord = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Application.ScreenUpdating = True
End Sub
Update1: Đã chạy thực tế. Xuất hiện vấn đề là copy các từ cần thay thế thì lại bị lỗi font tiếng việt. Nên khi chạy thì không có thay đổi gì các bác ạ
Em có link file em thử làm ạ. Đoạn chữ màu đỏ là các từ cần bỏ. Đoạn văn bản phía dưới là đoạn cần chỉnh sửa ạ.
https://drive.google.com/file/d/1QjmyeJixRySm4OCDdb3t0DZyHxmQyX7D/view?usp=sharing
Last edited: