Mã hóa dãy số dài thành chuỗi ngắn

Phuocam · 23/5/21

phạm quyên đã viết:
Hay quá ạ, có thể gắn file excel em kèm lên được không ạ, em không biết phải nhúng và chạy cái đoạn code trên như thế nào ạ, có phải tạo cái nút " mã hóa - giải mã" gì không hay là nó tự chạy ạ

Không biết sử dụng, sao biết "Hay quá" ???

phạm quyên · 23/5/21

phuocam đã viết:
Không biết sử dụng, sao biết "Hay quá" ???

Hihi, em nhìn hình file excel ra kết quả thấy thích quá ạ. Cảm ơn anh ạ

Bài đã được tự động gộp: 23/5/21

phuocam đã viết:
Không biết sử dụng, sao biết "Hay quá" ???

Dạ, vậy là code đó viết dưới dạng add-in excel, hị hị

batman1 · 23/5/21

ptm0412 đã viết:
Hàm dưới đây không tổng quát như của

Function Giaima(MStr As String) As String
Dim Tmp As String, Rs As LongLong

Nhưng tôi dùng Excel 2013 32 bit thì làm gì có kiểu LongLong?

Ngày nghỉ rỗi hơi, tham gia tí

Mã:

Function encoding_number(ByVal number As Double) As String
'    mã hóa dùng 200 ký tự unicode trong Unicode Block “Latin Extended-B”, bắt đầu từ U + 0180
Dim a As Double, b As Long, result As String
    Do While number
        a = number
        number = Int(number / 200)
        b = a - number * 200
        result = ChrW(b + &H180) & result
    Loop
    encoding_number = result
End Function

Function decoding_code(ByVal code As String) As String
Dim k As Long, a As Long, result
    If Len(code) = 0 Then Exit Function
    For k = 1 To Len(code) - 2
        result = (result + (AscW(Mid(code, k, 1)) - &H180)) * 200
    Next k
    If Len(code) > 1 Then result = (result + (AscW(Mid(code, Len(code) - 1, 1)) - &H180)) * 2
    a = AscW(Mid(code, Len(code), 1)) - &H180
    result = (result + a \ 100) & (a Mod 100)
    If Mid(result, 1, 1) = "0" Then result = Mid(result, 2)
    decoding_code = result
End Function

Bài đã được tự động gộp: 23/5/21

phạm quyên đã viết:
Hihi, em nhìn hình file excel ra kết quả thấy thích quá ạ.

Bạn hãy nhập dữ liệu đầu vào vd. 1931825452366542 ̣(16 chữ số CÓ NGHĨA). Sauđó tính MÃ. Tiếp theo giải mã cái MÃ kia. Cuối cùng kiểm tra xem kêt quả giải mã có đúng là 1931825452366542 không nhé.

phạm quyên · 23/5/21

batman1 đã viết:
Nhưng tôi dùng Excel 2013 32 bit thì làm gì có kiểu LongLong?

Ngày nghỉ rỗi hơi, tham gia tí

Mã:

Function encoding_number(ByVal number As Double) As String ' mã hóa dùng 200 ký tự unicode trong Unicode Block “Latin Extended-B”, bắt đầu từ U + 0180 Dim a As Double, b As Long, result As String Do While number a = number number = Int(number / 200) b = a - number * 200 result = ChrW(b + &H180) & result Loop encoding_number = result End Function Function decoding_code(ByVal code As String) As String Dim k As Long, a As Long, result If Len(code) = 0 Then Exit Function For k = 1 To Len(code) - 2 result = (result + (AscW(Mid(code, k, 1)) - &H180)) * 200 Next k If Len(code) > 1 Then result = (result + (AscW(Mid(code, Len(code) - 1, 1)) - &H180)) * 2 a = AscW(Mid(code, Len(code), 1)) - &H180 result = (result + a \ 100) & (a Mod 100) If Mid(result, 1, 1) = "0" Then result = Mid(result, 2) decoding_code = result End Function

Bài đã được tự động gộp: 23/5/21

Bạn hãy nhập dữ liệu đầu vào vd. 1931825452366542 ̣(16 chữ số CÓ NGHĨA). Sauđó tính MÃ. Tiếp theo giải mã cái MÃ kia. Cuối cùng kiểm tra xem kêt quả giải mã có đúng là 1931825452366542 không nhé.

ui, mã của anh khủng quá á, em cần mã chỉ gồm ký tự a-z, A-Z và số thôi á, mã của anh như hacker ấy, hịhị

Bài đã được tự động gộp: 23/5/21

batman1 · 23/5/21

Code hàm decoding_code ở bài #23 "phức tạp" thế là do dữ liệu có thể có 16 chữ số. Nếu dữ liệu chỉ có nhiều nhất 15 chữ số thì

Mã:

Function decoding_code(ByVal code As String) As String
Dim k As Long, result
    If Len(code) = 0 Then Exit Function
    For k = 1 To Len(code) - 1
        result = (result + (AscW(Mid(code, k, 1)) - &H180)) * 200
    Next k
    decoding_code = result + AscW(Mid(code, Len(code), 1)) - &H180
End Function

phạm quyên · 23/5/21

batman1 đã viết:
Code hàm decoding_code ở bài #23 "phức tạp" thế là do dữ liệu có thể có 16 chữ số. Nếu dữ liệu chỉ có nhiều nhất 15 chữ số thì

Mã:

Function decoding_code(ByVal code As String) As String Dim k As Long, result If Len(code) = 0 Then Exit Function For k = 1 To Len(code) - 1 result = (result + (AscW(Mid(code, k, 1)) - &H180)) * 200 Next k decoding_code = result + AscW(Mid(code, Len(code), 1)) - &H180 End Function

hic, mã của em hiện tại có 16 số anh ạ.

batman1 · 23/5/21

phạm quyên đã viết:
ui, mã của anh khủng quá á, em cần mã chỉ gồm ký tự a-z, A-Z và số thôi á, mã của anh như hacker ấy, hịhị

Mã là mã, đâu cần "đẹp" như hoa hậu. Mà mã nhìn rối mắt mới hay.

phạm quyên · 23/5/21

batman1 đã viết:
Mã là mã, đâu cần "đẹp" như hoa hậu. Mà mã nhìn rối mắt mới hay.

dạ, nhưng mã ấy copy vào web bán hàng nó ko cho ạ, help help

batman1 · 23/5/21

phạm quyên đã viết:
hic, mã của em hiện tại có 16 số anh ạ.

Tôi biết nên mới cung cấp code bài #23 chứ không cho code bài #25. Bài #25 chẳng qua là nói rõ lý do, vì sao tôi "xoay xở" như thế. Biết đâu có người cũng sẽ ý thức được là cần "xoay xở", nhưng họ có thể chọn cách "xoay xở" khác.

phạm quyên · 23/5/21

batman1 đã viết:
Tôi biết nên mới cung cấp code bài #23 chứ không cho code bài #25. Bài #25 chẳng qua là nói rõ lý do, vì sao tôi "xoay xở" như thế. Biết đâu có người cũng sẽ ý thức được là cần "xoay xở", nhưng họ có thể chọn cách "xoay xở" khác.

Em cảm ơn anh nhiều ạ

batman1 · 23/5/21

phạm quyên đã viết:
dạ, nhưng mã ấy copy vào web bán hàng nó ko cho ạ, help help

Tự test nhé.

Mã:

Const sBaseStr As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx"

Function encoding_number(ByVal number As Double) As String
Dim a As Double, b As Long, result As String
    If number = 0 Then result = "0"
    Do While number
        a = number
        number = Int(number / 60)
        b = a - number * 60
        result = Mid(sBaseStr, b + 1, 1) & result
    Loop
    encoding_number = result
End Function

Function decoding_code(ByVal code As String) As String
Dim k As Long, a As Long, result
    If Len(code) = 0 Then Exit Function
    For k = 1 To Len(code) - 2
        result = (result + (InStr(1, sBaseStr, Mid(code, k, 1), vbBinaryCompare) - 1)) * 60
    Next k
    If Len(code) > 1 Then result = (result + (InStr(1, sBaseStr, Mid(code, Len(code) - 1, 1), vbBinaryCompare) - 1)) * 6
    a = InStr(1, sBaseStr, Mid(code, Len(code), 1), vbBinaryCompare) - 1
    result = (result + a \ 10) & (a Mod 10)
    If Mid(result, 1, 1) = "0" Then result = Mid(result, 2)
    decoding_code = result
End Function

phạm quyên · 23/5/21

batman1 đã viết:

Tự test nhé.

Mã:

Const sBaseStr As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx"

Function encoding_number(ByVal number As Double) As String
Dim a As Double, b As Long, result As String
    If number = 0 Then result = "0"
    Do While number
        a = number
        number = Int(number / 60)
        b = a - number * 60
        result = Mid(sBaseStr, b + 1, 1) & result
    Loop
    encoding_number = result
End Function

Function decoding_code(ByVal code As String) As String
Dim k As Long, a As Long, result
    If Len(code) = 0 Then Exit Function
    For k = 1 To Len(code) - 2
        result = (result + (InStr(1, sBaseStr, Mid(code, k, 1), vbBinaryCompare) - 1)) * 60
    Next k
    If Len(code) > 1 Then result = (result + (InStr(1, sBaseStr, Mid(code, Len(code) - 1, 1), vbBinaryCompare) - 1)) * 6
    a = InStr(1, sBaseStr, Mid(code, Len(code), 1), vbBinaryCompare) - 1
    result = (result + a \ 10) & (a Mod 10)
    If Mid(result, 1, 1) = "0" Then result = Mid(result, 2)
    decoding_code = result
End Function

Tuyệt vời quá anh ạ, Cảm ơn anh nhiều nhiều.

batman1 · 23/5/21

phạm quyên đã viết:
Tuyệt vời quá anh ạ, Cảm ơn anh nhiều nhiều.

Bạn nên định dạng cột Input và Output là TEXT

phạm quyên · 23/5/21

batman1 đã viết:
Bạn nên định dạng cột Input và Output là TEXT

Cảm ơn anh ạ, em làm theo ạ

ptm0412 · 23/5/21

batman1 đã viết:
Nhưng tôi dùng Excel 2013 32 bit thì làm gì có kiểu LongLong?
....
Tự test nhé.

Tôi cũng thử test và có cảm giác với các số lớn gần bằng 10^16 thì có chút sai số (kể cả LongLong).

HieuCD · 24/5/21

ptm0412 đã viết:
Tôi cũng thử test và có cảm giác với các số lớn gần bằng 10^16 thì có chút sai số (kể cả LongLong).

View attachment 259281

Excel và VBA khi tính toán chỉ nhận biết chính xác số có 15 ký tự, nhiều hơn phải tách thành nhiều số có chiều dài tối đa 15 ký tự

batman1 · 24/5/21

ptm0412 đã viết:
Tôi cũng thử test và có cảm giác với các số lớn gần bằng 10^16 thì có chút sai số (kể cả LongLong).

He he. Tức những "số" có 16 chữ số không tin tưởng được. Nhưng anh để ý là không phải số nào cũng thế. Trên hình đính kèm thì chỉ những số lẻ mới sai. Tuy nhiên tôi nghi là với những số 16 chữ số thì sẽ có những số sai, không nhất thiết số lẻ sai. Có thể vài số liên tiếp đều bị sai.

Thôi thì "xoay xở" tiếp. Không chỉ với decoding mà cả encoding cũng phải "xoay xở".

Alô alô, chủ thớt test lại code mới nhé.

Nếu chuỗi nguồn rỗng thì kết quả cũng rỗng.

Mã:

Const sBaseStr As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx"

Function encoding_number(ByVal number As String) As String
Dim a As Double, b As Long, so As Double, result As String
    If Len(number) = 1 Then
        encoding_number = Mid(sBaseStr, number + 1, 1)
        number = ""
    End If
    If Len(number) = 0 Then Exit Function
    b = Right(number, 1)
    a = Left(number, Len(number) - 1)
    so = Int(a / 6 + b / 60)
    b = (a - so * 6) * 10 + b
    result = Mid(sBaseStr, b + 1, 1)
    Do While so
        a = so
        so = Int(so / 60)
        b = a - so * 60
        result = Mid(sBaseStr, b + 1, 1) & result
    Loop
    encoding_number = result
End Function

Function decoding_code(ByVal code As String) As String
Dim k As Long, a As Long, result
    If Len(code) = 0 Then Exit Function
    For k = 1 To Len(code) - 2
        result = (result + (InStr(1, sBaseStr, Mid(code, k, 1), vbBinaryCompare) - 1)) * 60
    Next k
    If Len(code) > 1 Then result = (result + (InStr(1, sBaseStr, Mid(code, Len(code) - 1, 1), vbBinaryCompare) - 1)) * 6
    a = InStr(1, sBaseStr, Mid(code, Len(code), 1), vbBinaryCompare) - 1
    result = (result + a \ 10) & (a Mod 10)
    If Mid(result, 1, 1) = "0" Then result = Mid(result, 2)
    decoding_code = result
End Function

phạm quyên · 24/5/21

batman1 đã viết:
He he. Tức những "số" có 16 chữ số không tin tưởng được. Nhưng anh để ý là không phải số nào cũng thế. Trên hình đính kèm thì chỉ những số lẻ mới sai. Tuy nhiên tôi nghi là với những số 16 chữ số thì sẽ có những số sai, không nhất thiết số lẻ sai. Có thể vài số liên tiếp đều bị sai.

Thôi thì "xoay xở" tiếp. Không chỉ với decoding mà cả encoding cũng phải "xoay xở".

Alô alô, chủ thớt test lại code mới nhé.

Nếu chuỗi nguồn rỗng thì kết quả cũng rỗng.

Mã:

Const sBaseStr As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx" Function encoding_number(ByVal number As String) As String Dim a As Double, b As Long, so As Double, result As String If Len(number) = 1 Then encoding_number = Mid(sBaseStr, number + 1, 1) number = "" End If If Len(number) = 0 Then Exit Function b = Right(number, 1) a = Left(number, Len(number) - 1) so = Int(a / 6 + b / 60) b = (a - so * 6) * 10 + b result = Mid(sBaseStr, b + 1, 1) Do While so a = so so = Int(so / 60) b = a - so * 60 result = Mid(sBaseStr, b + 1, 1) & result Loop encoding_number = result End Function Function decoding_code(ByVal code As String) As String Dim k As Long, a As Long, result If Len(code) = 0 Then Exit Function For k = 1 To Len(code) - 2 result = (result + (InStr(1, sBaseStr, Mid(code, k, 1), vbBinaryCompare) - 1)) * 60 Next k If Len(code) > 1 Then result = (result + (InStr(1, sBaseStr, Mid(code, Len(code) - 1, 1), vbBinaryCompare) - 1)) * 6 a = InStr(1, sBaseStr, Mid(code, Len(code), 1), vbBinaryCompare) - 1 result = (result + a \ 10) & (a Mod 10) If Mid(result, 1, 1) = "0" Then result = Mid(result, 2) decoding_code = result End Function

Em cảm ơn các anh đã nhiệt tình code cho em ạ, thật không biết nói gì hơn, các anh thật là siêu quá ạ.

phạm quyên · 24/5/21

phạm quyên đã viết:
Em cảm ơn các anh đã nhiệt tình code cho em ạ, thật không biết nói gì hơn, các anh thật là siêu quá ạ.

Em test nó ra thế này ạ, em có sửa tên funtion thành mahoa và giaima để khỏi trùng với tên cũ ạ

Phuocam · 24/5/21

phạm quyên đã viết:
Em test nó ra thế này ạ, em có sửa tên funtion thành mahoa và giaima để khỏi trùng với tên cũ ạ

Muốn sửa, phải sửa toàn bộ, không phải chỉ sửa tên hàm.

Mã hóa dãy số dài thành chuỗi ngắn

Thành viên mới

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Bad Excel Member

Chuyên gia GPE

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên mới

Đếm ngược thời gian