Hướng dẫn tạo Nút bấm sắp xếp họ tên tiếng Việt trong LibreOffice Calc (2 người xem)

hng1635 · Hôm qua, lúc 23:57

Bài toán sắp xếp tên tiếng Việt trên Excel đã được giải quyết từ rất lâu rồi và hiện nay có nhiều addin hỗ trợ, tuy nhiên với LibreOffice Calc thì chưa thấy có giải pháp nào làm việc tương ứng. Nay nhân tiện có con Gemini nên bắt nó viết đoạn code để dùng, thấy cũng được nên viết bài để chia sẻ cho anh em nào dùng LibreOffice Calc.
Đây là đoạn code sắp xếp tiếng Việt:

PHP:

REM === MACRO SẮP XẾP HỌ TÊN TIẾNG VIỆT TRỰC TIẾP TRÊN VÙNG CHỌN ===

Sub SapXepTenTiengViet_Click()
    Dim oDoc As Object, oSel As Object
    oDoc = ThisComponent
    oSel = oDoc.CurrentSelection
    
    ' 1. Kiểm tra vùng chọn
    If Not oSel.supportsService("com.sun.star.sheet.SheetCellRange") Then
        MsgBox "Vui lòng bôi đen vùng dữ liệu cần sắp xếp!", 48, "Lỗi thao tác"
        Exit Sub
    End If
    
    Dim numCols As Long
    numCols = oSel.Columns.Count
    
    Dim keyColIndex As Long
    keyColIndex = 0 ' Mặc định là cột đầu tiên (chỉ số 0)
    
    ' 2. Hỏi người dùng nếu chọn nhiều cột
    If numCols > 1 Then
        Dim userInput As String
        userInput = InputBox("Bạn đã bôi đen " & numCols & " cột." & Chr(10) & _
                             "Nhập SỐ THỨ TỰ của cột chứa HỌ TÊN để làm chuẩn sắp xếp:" & Chr(10) & _
                             "(Tính từ trái sang phải trong vùng đã chọn, bắt đầu từ 1)", "Chọn cột sắp xếp", "1")
                            
        ' Nếu người dùng bấm Cancel hoặc bỏ trống
        If userInput = "" Then Exit Sub
        
        ' Kiểm tra xem có nhập đúng số không
        If Not IsNumeric(userInput) Then
            MsgBox "Vui lòng nhập một số nguyên hợp lệ!", 48, "Lỗi"
            Exit Sub
        End If
        
        keyColIndex = CLng(userInput) - 1 ' Trừ 1 vì mảng bắt đầu từ 0
        
        If keyColIndex < 0 Or keyColIndex >= numCols Then
            MsgBox "Số thứ tự cột không hợp lệ! Vui lòng nhập từ 1 đến " & numCols, 48, "Lỗi"
            Exit Sub
        End If
    End If
    
    Dim mData As Variant
    mData = oSel.getDataArray() ' Lấy mảng dữ liệu (mỗi phần tử là 1 dòng chứa các cột)
    
    Dim UBR As Long
    UBR = UBound(mData)
    
    If UBR <= 0 Then
        MsgBox "Vùng chọn cần có ít nhất 2 dòng để thực hiện sắp xếp.", 48, "Thông báo"
        Exit Sub
    End If
    
    ' Khởi tạo Collator Tiếng Việt
    Dim oCollator As Object
    Dim aLocale As New com.sun.star.lang.Locale
    aLocale.Language = "vi"
    aLocale.Country = "VN"
    oCollator = CreateUnoService("com.sun.star.i18n.Collator")
    oCollator.loadDefaultCollator(aLocale, 0)
    
    ' 3. Tạo mảng phụ để lưu TOÀN BỘ DÒNG và Khóa sắp xếp
    Dim arr() As Variant
    ReDim arr(0 To UBR)
    Dim i As Long, j As Long
    
    For i = 0 To UBR
        Dim tenGoc As String
        ' Chỉ lấy chuỗi ở cột người dùng đã chỉ định để tạo khóa sắp xếp
        tenGoc = CStr(mData(i)(keyColIndex))
        Dim khoaSapXep As String
        khoaSapXep = TenHoLot(tenGoc)
        
        ' Lưu lại mảng gồm: [0] Toàn bộ dữ liệu dòng hiện tại, [1] Khóa sắp xếp
        arr(i) = Array(mData(i), khoaSapXep)
    Next i
    
    ' 4. Thuật toán sắp xếp (Hoán vị toàn bộ dòng)
    Dim temp As Variant
    For i = 0 To UBR - 1
        For j = i + 1 To UBR
            If oCollator.compareString(arr(i)(1), arr(j)(1)) = 1 Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    
    ' 5. Đổ dữ liệu đã sắp xếp ngược lại mảng gốc
    For i = 0 To UBR
        mData(i) = arr(i)(0) ' Trả lại toàn bộ các cột của dòng đó
    Next i
    
    ' 6. Ghi dữ liệu đè lên Sheet
    oSel.setDataArray(mData)
    
    MsgBox "Tuyệt vời! Đã sắp xếp xong " & (UBR + 1) & " dòng dữ liệu theo đúng chuẩn tiếng Việt.", 64, "Hoàn tất"
End Sub

' =========================================================
' CÁC HÀM HỖ TRỢ BÊN DƯỚI (Cần giữ lại để phục vụ Macro)
' =========================================================

Function Del_Space(ByVal ChuoiData As String) As String
    ChuoiData = Trim(ChuoiData)
    While InStr(ChuoiData, "  ") > 0
        ChuoiData = Replace(ChuoiData, "  ", " ")
    Wend
    Del_Space = ChuoiData
End Function

Function TachHo(ByVal Str As String, Optional Kt As Variant) As String
    If IsMissing(Kt) Then Kt = True
    If Kt Then Str = Del_Space(Str)
    Dim spacePos As Integer
    spacePos = InStr(1, Str, " ")
    If Len(Str) = 0 Or spacePos = 0 Then TachHo = Str Else TachHo = Left(Str, spacePos - 1)
End Function

Function TachTen(ByVal Str As String, Optional Kt As Variant) As String
    If IsMissing(Kt) Then Kt = True
    If Kt Then Str = Del_Space(Str)
    Dim spacePos As Integer
    spacePos = InStrRev(Str, " ")
    If Len(Str) = 0 Or spacePos = 0 Then TachTen = Str Else TachTen = Right(Str, Len(Str) - spacePos)
End Function

Function TachChuLot(ByVal Str As String, Optional Kt As Variant) As String
    If IsMissing(Kt) Then Kt = True
    If Kt Then Str = Del_Space(Str)
    Dim ten As String, ho As String
    ten = TachTen(Str, False) : ho = TachHo(Str, False)
    If ho & " " & ten = Str Or ho = Str Then
        TachChuLot = ""
    Else
        TachChuLot = Mid(Str, Len(ho) + 2, Len(Str) - Len(ho) - Len(ten) - 2)
    End If
End Function

Function TenHoLot(ByVal Str As String) As String
    Str = Del_Space(Str)
    Dim ten As String, ho As String, lot As String
    ten = TachTen(Str, False) : ho = TachHo(Str, False) : lot = TachChuLot(Str, False)
    Dim Result As String
    Result = ""
    If Len(ten) > 0 Then Result = Result & ten & " "
    If Len(ho) > 0 Then Result = Result & ho & " "
    If Len(lot) > 0 Then Result = Result & lot
    TenHoLot = Trim(Result)
End Function
' Hàm tự tạo thay thế cho InStrRev của VBA (Tìm kiếm từ phải sang trái)
Function InStrRev(ByVal strCheck As String, ByVal strMatch As String) As Integer
    Dim i As Integer
    If Len(strMatch) = 0 Or Len(strCheck) = 0 Then
        InStrRev = 0
        Exit Function
    End If
    
    ' Chạy vòng lặp ngược từ cuối chuỗi lên đầu chuỗi
    For i = Len(strCheck) To 1 Step -1
        If Mid(strCheck, i, Len(strMatch)) = strMatch Then
            InStrRev = i
            Exit Function
        End If
    Next i
    
    InStrRev = 0 ' Trả về 0 nếu không tìm thấy
End Function

Cách thêm nút bấm vào thanh công cụ:

Lưu mã lệnh: Mở LibreOffice Calc, chọn Tools > Macros > Edit Macros.
Tìm đến mục My Macros > Standard > Module1. Dán toàn bộ đoạn mã trên vào khung soạn thảo rồi lưu lại (Ctrl+S). Đóng cửa sổ Macro.

Tạo nút trên thanh công cụ (Toolbar):
- Trong Calc, chọn Tools > Customize...
- Chuyển sang thẻ Toolbars.
- Bên ô Target, chọn thanh công cụ bạn muốn hiển thị nút (ví dụ: Standard).
- Bấm vào nút Add Command... (ở bên phải hoặc phía dưới tùy phiên bản).
- Trong cửa sổ hiện ra, kéo xuống phần Category ở góc trái dưới cùng, chọn LibreOffice Macros > My Macros > Standard > Module1.
- Ở cột Commands bên phải, chọn SapXepTenTiengViet_Click rồi nhấn Add.
Tân trang cho nút bấm: Sau khi Add, lệnh sẽ nằm trong thanh công cụ của bạn. Bạn có thể chọn nó, bấm Modify > Rename... để đổi tên thành "Sắp Xếp Tên VN", và Modify > Change Icon... để chọn một icon đẹp mắt. Nhấn OK.